\ 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* ;