Path: ...!weretis.net!feeder9.news.weretis.net!news.nk.ca!rocksolid2!i2pn2.org!.POSTED!not-for-mail From: melahi_ahmed@yahoo.fr (ahmed) Newsgroups: comp.lang.forth Subject: Re: Differentiable Forth Date: Fri, 19 Jul 2024 19:19:24 +0000 Organization: novaBBS Message-ID: References: <7e6998ad43698a3e80e2483e932ec7a1@www.novabbs.com> <06155327b9b2e4b08c479044803e2511@www.novabbs.com> <8f86fe925de98123b5ec47a1c49c67ca@www.novabbs.com> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Injection-Info: i2pn2.org; logging-data="3858891"; mail-complaints-to="usenet@i2pn2.org"; posting-account="fh2jRJ/PGtIlZMySaIjc6gsLWP80WZpB2lZYFC5wgKI"; User-Agent: Rocksolid Light X-Rslight-Site: $2y$10$8gKDKI3SQ1pdHJmv9m3Kb.Q9r9ZFQe/btNET.eJ6fGh0Q8mtvEjtC X-Rslight-Posting-User: a55529988cdb6fa7b5e36631aef8884238b8448a X-Spam-Checker-Version: SpamAssassin 4.0.0 Bytes: 12664 Lines: 453 On Fri, 19 Jul 2024 18:01:39 +0000, minforth wrote: > I don't know if gforth has z: locals for complex numbers. If yes, they > could be used for dual fp-numbers as well to reduce code overhead and > improve readability. Yes, z: locals exists in gforth but I haven't used it. I didn't want to mix dual and complex numbers. I have completed the code with the elementary functions and their derivatives (exp, ln, trigs, inverse trig, hyperbolic, inverse hyperbolic, ...). The code is not optimized and can be improved. I've done it just as a proof of concept. I added examples for functions with multiple variables (3 variables x y and z) Perhaps, one must separate dual numbers, dual number valued functions of dual numbers variables, ..., and the examples. Here is the code: : -frot frot frot ; : f>dl ( f: a -- a 0) 0e ; \ real to dual value : f>dl_d ( f: a -- a 1) 1e ; \ real to dual value with respect to differentiate : dl>rl ( f: a b -- a) fdrop ; : dl>eps ( f: a b -- b) fnip ; : dl. ( f: a b -- ) fswap f. ." + eps " f. ; : dl(,). ( f: a b -- ) ." (" fswap f. ." , " f. ." )" ; : dl+ ( f: a b c d -- a+c b+d) frot ( f: a c d b) f+ ( f: a c b+d) -frot ( f: b+d a c) f+ ( f: b+d a+c) fswap ( f: a+c b+d) ; : dl- ( f: a b c d -- a-c b-d) frot ( f: a c d b) fswap f- ( f: a c b-d) -frot ( f: b-d a c) f- ( f: b-d a-c) fswap ( f: a-c b-d) ; fvariable b*c : dl* ( f: a b c d -- a*c a*d+b*c) -frot ( f: a d b c) ftuck f* ( f: a d c b*c) b*c f! ( f: a d c) frot ( f: d c a) ftuck ( f: d a c a) f* ( f: d a a*c) -frot ( f: a*c d a) f* b*c f@ f+ ( f: a*c a*d+b*c) ; : 1/dl ( f: a b -- 1/a -b*1/a^2) fswap 1/f ( f: b 1/a) ftuck ( f: 1/a b 1/a) fdup f* ( f: 1/a b 1/a^2) f* fnegate ( f: 1/a -b/a^2) ; : dl/ ( f: a b c d -- a/c rest) 1/dl dl* ; : dl^f ( f: a b c -- a^c b*c) ftuck ( f: a c b c) f* -frot ( f: b*c a c) f** fswap ( f: a^c b*c) ; \ : dldup ( f: a b -- a b a b) fover fover ; : dlnip ( f: a b c d -- c d) frot fdrop frot fdrop ; : dldrop ( f: a b -- ) fdrop fdrop ; fvariable dlswap_temp : dlswap ( f: a b c d -- c d a b) frot dlswap_temp f! ( f: a c d) frot ( f: c d a) dlswap_temp f@ ; fvariable dlover_temp1 fvariable dlover_temp2 : dlover ( f: a b c d -- a b c d a b) dlswap ( f: a b c d -- c d a b) dlover_temp2 f! dlover_temp1 f! ( f: c d) dlover_temp1 f@ dlover_temp2 f@ ( f: c d a b) dlswap ( f: a b c d) dlover_temp1 f@ dlover_temp2 f@ ( f: a b c d a b) ; : dltuck dlswap dlover ; : dlvariable create 2 floats allot ; : dl! ( dlvar -- ) ( f: f1 f2 -- ) dup float+ f! f! ; : dl@ ( dlvar -- ) ( f: -- f1 f2) dup f@ float+ f@ ; dlvariable dlrot_temp1 dlvariable dlrot_temp2 : dlrot ( dl: d1 d2 d3 -- d2 d3 d1) dlrot_temp1 dl! ( dl: d1 d2) dlswap ( dl: d2 d1) dlrot_temp2 dl! ( dl: d2) dlrot_temp1 dl@ ( dl: d2 d3) dlrot_temp2 dl@ ( dl: d2 d3 d1) ; \ dual number funuctions of dula number variables : dlident ( f: a b -- a b) ; : dlexp ( f: a b -- c d) fswap fdup fexp fswap fexp frot f* ; : dlln ( f: a b -- c d) fswap fdup fln fswap 1/f frot f* ; : dl^ ( dl: a b -- a^b) \ a^b = exp(b*ln(a)) dlswap dlln dl* dlexp ; : dlsqrt ( dl: x --y) 0.5e f>dl dl^ ; : dlsin ( f: a b -- c d) fswap fdup fsin fswap fcos frot f* ; : dlcos ( f: a b -- c d) fswap fdup fcos fswap fsin fnegate frot f* ; : dltan ( dl: x -- y) dldup dlsin dlswap dlcos dl/ ; : dlcot ( dl: x -- y) dltan 1/dl ; : dlsinh ( dl: x -- y) dldup dlexp dlswap -1e f>dl dl* dlexp dl- 2e f>dl dl/ ; : dlcosh ( dl: x -- y) dldup dlexp dlswap -1e f>dl dl* dlexp dl+ 2e f>dl dl/ ; : dltanh ( dl: x -- y) dldup dlsinh dlswap dlcosh dl/ ; : dlcoth ( dl: x -- y) dltanh 1/dl ; : dlasin ( f: a b -- c d) fswap fdup fasin fswap fdup f* 1e fswap f- fsqrt 1/f frot f* ; : dlacos ( f: a b -- c d) fswap fdup facos fswap fdup f* 1e fswap f- fsqrt 1/f fnegate frot f* ; : dlatan ( f: a b -- c d) fswap fdup fatan fswap fdup f* 1e f+ 1/f frot f* ; : dlasinh ( f: a b -- c d) fswap fdup fasin fswap fdup f* 1e f+ fsqrt 1/f frot f* ; : dlacosh ( f: a b -- c d) fswap fdup facos fswap fdup f* 1e f- fsqrt 1/f fnegate frot f* ; : dlatanh ( f: a b -- c d) fswap fdup fatanh fswap fdup f* 1e fswap f- 1/f frot f* ; \ ..... add others \ derivatives variable func : der 1e ' func ! func @ execute dl>eps ; \ examples 1 [if] : dlf() 1e 0e dl+ ; \ f(x) = x + 1 : dlf2() dldup dl* ; \ f2(x) = x^2 : dlf3() dldup dlf2() dlswap dlf() dl+ ; \ f3(x) = x^2 + x + 1 : der_f3() ( f: x -- y) 2e f* 1e f+ ; \ d/dx(f3) = 2*x + 1 cr 1e der dlf3() f. \ 3. ok cr 1e der_f3() f. \ 3. ok cr cr : dlf4() dlf3() dlexp ; \ f3(x) = exp(x^2+x+1) ========== REMAINDER OF ARTICLE TRUNCATED ==========