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: <b0ea2fba69e0b5936aeca68fd0cb924f@www.novabbs.com>
References: <e9689378e46f06961fe4fe43b47dfd3b@www.novabbs.com> <v766m4$3hipk$1@news.xmission.com> <f806c73034c83af94d0ce3d857075241@www.novabbs.com> <7e6998ad43698a3e80e2483e932ec7a1@www.novabbs.com> <06155327b9b2e4b08c479044803e2511@www.novabbs.com> <a6052445cfd6c3264ff86446dbbe2d37@www.novabbs.com> <a8ec944a53a7b48d3994102035e987ab@www.novabbs.com> <cf3e51477813a438fe9f5f632a0ce90f@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 ==========