\ Simulated annealing minimizer
\ version of October 1st, 2000

FALSE [IF]
    Algorithm:
        0. Set the "temperature" T.
        1. Choose a point at random and compute f(x)
        2. If f < f_old then keep the new point;
        3. If f > f_old then compute P = exp[- (f - f_old)/T]
        4. Compute a random number -- if r < P then keep the new
           point else discard it.
        5. Reduce T gradually according to a reasonable schedule
           until the system settles down.

[THEN]

marker -anneal

: undefined   BL WORD  FIND  NIP  0=  ;

\ vectoring: for fwd recursion, or using function names as arguments

undefined use(  [IF]
    : use(      '       \ state-smart ' for syntactic sugar
        STATE @  IF  POSTPONE LITERAL  THEN  ;  IMMEDIATE

    ' NOOP  CONSTANT  'noop
    : v:   CREATE  'noop  ,  DOES> PERFORM  ;   \ create dummy def'n
    : 'dfa   ' >BODY  ;                         ( -- data field address)
    : defines    'dfa   STATE @
             IF   POSTPONE  LITERAL    POSTPONE  !
             ELSE   !   THEN  ;  IMMEDIATE
[THEN]
\ end vectoring

undefined  prng  [IF]  include  prng.f  [THEN]

v: fdummy

100 VALUE  Ntimes

FVARIABLE T_0
FVARIABLE old_f
FVARIABLE dT
FVARIABLE old_y
FVARIABLE yp

: x     ( f: -- x)      \ x in range -inf to +inf
    prng
    1e  FOVER  F-  F/  FLN
    FDUP  yp F!  ;

0.1  seed 2!

: initialize   ( xt --)    ( f: T_0 -- T_0)
    defines fdummy
    T_0  F!
    T_0  F@  FDUP  10e F/  dT  F!
    x fdummy  old_f  F!
;

: keep   ( f: f[y] --)  old_f F!   yp F@  old_y F!  ;

: select    ( f: T f -- T)
    FOVER FOVER             ( f: T f T f)
    old_f F@  F-   FDUP     ( f: T f T df df)
    F0< IF      FDROP  FDROP   keep         \ f < old_f so store f.
                EXIT    THEN
    FSWAP F/  FNEGATE  FEXP ( f: T f P)     \ f > old_f so compute P.
    prng  F>  IF    keep                    \ store f with prob P
              ELSE  FDROP  THEN             \ otherwise do nothing
;


: )anneal   ( xt --)    ( f: T_0 -- f_min)
    initialize          ( f: T_0)
    BEGIN   FDUP   0e  F>
    WHILE   Ntimes 0 DO
                x  fdummy  select
            LOOP
            dT F@  F-
    REPEAT              ( f: T_f)
    FDROP  old_f  F@   old_y F@  F. F.
;


: f1   ( f: x -- 1 -  x / e^x )
    FDUP  FEXP  F/  FNEGATE  1e  F+  ;

: f2   ( f: x -- [[x-1]^2-0.75]*[[x-2]^2-2] )
    FDUP  1e F-  FDUP F*  0.75e F-
    FSWAP 2e F-  FDUP F*  2e F-  F*  ;

: f3    ( f: x -- [x^2-2*x+.25]*[x^2-4*x+2]^3 )
    FDUP FDUP  2E0  F-  F*  0.25E0  F+
    FSWAP
    FDUP  4E0 F-  F*  2E0 F+  FDUP FDUP F* F*
    F*  ;

: f4  fdup  1e0 f+  fover f*  fover f*  8e0 f+ f*  8e0 f+  ;     

: f5    ( f: x -- -xe^{-x}*sinh^2[x]/[1+cosh^2[x]] )
    fnegate
    fdup  fexp      ( f: -x e^{-x} )
    fdup  f^2       ( f: -x e^{-x} e^{-2x} )
    fdup  2e0 f-    ( f: -x e^{-x} u u-2 )  \ u=e^{-2x}
    fover f* 1e0 f+
    fswap
    fdup 6e0 f+ f* 1e0 f+
    f/ f* f*  ;