2013-09-17: added a minimal evolutionary algorithm which actually changes the

added a minimal evolutionary algorithm which actually changes the source-code.

diff --git a/examples/evolve.w b/examples/evolve.w
new file mode 100644
--- /dev/null
+++ b/examples/evolve.w
@@ -0,0 +1,102 @@
+#!/home/arne/wisp/wisp-multiline.sh 
+; !#
+
+; A small experiment on a complete evolutionary algorithm.
+
+; NOTE: This only works after preprocessing to scheme.
+
+define evalsyntax "0123456789+-*/ ()"
+
+define : mutate-replace evalstring
+       let 
+           : eval-index : random : string-length evalstring
+             replace-index : random : string-length evalsyntax
+           string-replace evalstring evalsyntax eval-index : + eval-index 1
+                                          . replace-index : + replace-index 1
+
+
+define : mutate-permutate evalstring
+       let 
+           : replace : random : string-length evalstring
+             by : random : string-length evalstring
+           string-replace evalstring evalstring replace : + replace 1
+                                          . by : + by 1
+
+
+define : mutate-insert evalstring
+       let 
+           : eval-index : random : string-length evalstring
+             insert-index : random : string-length evalsyntax
+           string-append 
+               substring evalstring 0 eval-index
+               string : string-ref evalsyntax insert-index
+               substring evalstring eval-index
+
+
+define : mutate-remove evalstring
+       if : <= 1 : string-length evalstring
+          ; cannot remove from a 0 string
+          . evalstring
+          let 
+               : eval-index : random : - (string-length evalstring) 1
+               string-append 
+                   substring evalstring 0 eval-index
+                   substring evalstring : + eval-index 1
+
+
+define : mutate-eval evalstring
+       eval-string : string-append "(" evalstring ")"
+
+
+define : better mutated original
+       < 
+         abs : - 42 : mutate-eval mutated
+         abs : - 42 : mutate-eval original
+
+
+define : evolve-step evalstring mutate
+       ; first try a random replacement, then try a permutation.
+       let : : newstring : mutate evalstring
+           catch #t
+               lambda :
+                        mutate-eval newstring
+               lambda : key . args
+                        set! newstring evalstring
+           if : better newstring evalstring
+              . newstring
+              . evalstring
+
+
+define : evolve-replace evalstring
+       evolve-step evalstring mutate-replace
+
+define : evolve-permutate evalstring
+       evolve-step evalstring mutate-permutate
+
+define : evolve-insert evalstring
+       evolve-step evalstring mutate-insert
+
+define : evolve-remove evalstring
+       evolve-step evalstring mutate-remove
+
+
+define : evolution initialstring steps
+       let loop : (step 0) (string initialstring)
+           let : : action : random 4
+               if : >= step steps
+                  . string
+                  cond 
+                    : = action 0
+                      loop (+ step 1) (evolve-replace string)
+                    : = action 1
+                      loop (+ step 1) (evolve-permutate string)
+                    : = action 2
+                      loop (+ step 1) (evolve-insert string)
+                    : = action 3
+                      loop (+ step 1) (evolve-remove string)
+                    
+define : run 
+       ; firstoff, seed the random number generator!
+       set! *random-state* : random-state-from-platform
+       display : evolution "+ 1 2" 1000
+       newline