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 07:39:04 +0000 Organization: novaBBS Message-ID: References: <7e6998ad43698a3e80e2483e932ec7a1@www.novabbs.com> <06155327b9b2e4b08c479044803e2511@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="3799940"; mail-complaints-to="usenet@i2pn2.org"; posting-account="fh2jRJ/PGtIlZMySaIjc6gsLWP80WZpB2lZYFC5wgKI"; User-Agent: Rocksolid Light X-Rslight-Site: $2y$10$YA7G/SaKzB8WNhKbfhkZKeZFkZHDdIchoVSgPOun5.aTon7AlES52 X-Rslight-Posting-User: a55529988cdb6fa7b5e36631aef8884238b8448a X-Spam-Checker-Version: SpamAssassin 4.0.0 Bytes: 7686 Lines: 262 I added some words and examples for the case of functions with two variables. See functions f9() and f10() in the examples Here the code begins. : -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) ; : 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* ; : 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* ; \ ..... 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) : der_f4() ( f: x -- y) \ d/dx(f4) = (2*x+1)*exp(x^2+x+1) fdup 2e f* 1e f+ fswap fdup fdup f* f+ 1e f+ fexp f* ; cr 2e der dlf4() f. \ 5483.16579214229 ok, calculated at 2e cr 2e der_f4() f. \ 5483.16579214229 ok cr cr : dlf5() 1/dl ; : der_f5() ( f: x) \ d/dx(f5) = -1/x^2 fdup f* 1/f fnegate ; cr 2e der dlf5() f. \ -0.25 ok calculated at 2e cr 2e der_f5() f. \ -0.25 cr cr : dlf6() dldup dldup dl* dlswap dlsin dl+ 1/dl ; \ f6(x) = 1/(x^2+sin(x)) \ using the derivative calculated analytically d/dx (f6(x)) = -(2*x+cos(x))/(x^2+sin(x))^2 : der_f6() ( f: x -- y) fdup fdup fdup f* fswap fsin f+ fdup f* 1/f fswap fdup 2e f* fswap fcos f+ f* fnegate ; cr 1e der dlf6() f. \ -0.749127330692909 ok calculated at x = 1 cr 1e der_f6() f. \ -0.749127330692909 ok cr cr : dlf7() dldup dldup dl* dlcos dl* ; \ f7(x) = x*cos(x^2), : der_f7() ( f: x --y) \ its deriv: d/dx(f7) = cos(x^2)-2*x^2*sin(x^2) fdup f* ( f: x^2) fdup fsincos ( f: x^2 s c ) -frot ( f: c x^2 s ) f* 2e f* ( f: c 2s*x^2) f- ; cr 1e der_f7() f. \ -1.14263966374765 ok calculated at 1e cr 1e der dlf7() f. \ -1.14263966374765 ok cr cr cr 2e der_f7() f. \ 5.40077634159981 ok calculated at 2e cr 2e der dlf7() f. \ 5.40077634159981 ok cr cr ========== REMAINDER OF ARTICLE TRUNCATED ==========