Re: Differentiable Forth

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
: dlf8() \ f8(x) = sin(sin(sin(x)))
    dlsin dlsin dlsin
;
: der_f8() \ d/dx(f8) = (sin(sin(x)))'*cos(sin(sin(x)))
           \          = (sin(x))'*cos(sin(x)*cos(sin(sin(x)))
           \          = cos(x)*cos(sin(x))*cos(sin(sin(x)))
    ( f: x -- y)
    fsincos ( f: s c)
    fswap   ( f: c s)
    fdup    ( f: c s s)
    fcos    ( f: c s cs)
    fswap   ( f: c cs s)
    fsin    ( f: c cs ss)
    fcos    ( f: c cs css)
    f* f*
;
cr 2e der dlf8() f. \
cr 2e der_f8() f.   \
cr cr
( f9 function)
: dl_f9() ( dl: x y -- z) \ f9(x,y) = x + 5*y + x*y
     dlover dlover dl* dlswap 5e f>dl dl* dl+ dl+
;
: df9/dx ( f: x y -- z) \ df9/dx = 1 + y
     fnip 1e f+
;
: df9/dy ( f: x y -- z) \ df9/dy = 5 + x
     fdrop 5e f+
;
cr 2e f>dl_d 3e f>dl dl_f9() dl>eps f. \
cr 2e    3e    df9/dx        f. \
cr
cr 2e f>dl 3e f>dl_d dl_f9() dl>eps f. \
cr 2e    3e    df9/dy        f. \
cr cr
( f10 function)
: dl_f10() ( dl: x y -- z) \ f10(x,y) = exp(x + 5*y) * sin(x*y)
     dlover dlover dl* dlsin ( dl: x y sxy)
     dlrot dlrot             ( dl: sxy x y)
     5e f>dl dl* dl+ dlexp   ( dl: sxy e^[x+5y])
     dl*
;
: df10/dx ( f: x y -- z) \ df10/dx = exp(x+5y)*(sin(x*y)+y*cos(x*y))
     fover fover 5e f* f+ fexp ( f: x y e^[x+5y])
     frot frot ( f: e^[x+5y] x y)
     ftuck     ( f: e^[x+5y] y x y)
     f* fsincos ( f: e^[x+5y] y sxy cxy)
     frot f* f+ ( f: e^[x+5y] sxy+ycxy)
     f*
;
: df10/dy ( f: x y -- z) \ df10/dy = exp(x+5y)*(5*sin(x*y) + x*cos(x*y))
     fover fover 5e f* f+ fexp ( f: x y e^[x+5y])
     frot frot ( f: e^[x+5y] x y)
     fover f*  ( f: e^[x+5y] x yx)
     fsincos   ( f: e^[x+5y] x sxy cxy)
     frot f* fswap 5e f* f+ ( f: e^[x+5y] 5sxy+xcxy)
     f*
;
cr 2e f>dl_d 3e f>dl dl_f10() dl>eps f. \
cr 2e    3e    df10/dx        f. \
cr
cr 2e f>dl 3e f>dl_d dl_f10() dl>eps f. \
cr 2e    3e    df10/dy        f. \
cr cr
cr cr cr
[then]
Here the code ends.
Ahmed