#|
 
Square Root Sample
 
Copyright (C) 2008 Jake Voytko
 
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation
files (the "Software"), to deal in the Software without restriction,
including without limitation the rights to use, copy, modify, merge,
publish, distribute, sublicense, and/or sell copies of the Software,
and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
 
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
 
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
|#
 
(defvar *sample-values*
  #(-1 1 genesis::num genesis::num randomnum randomfrac)
  "Sample values that can be produced. You can get either -1, 0, 1,
  a random number between 0 and 1023, a fraction of random integers,
  and the input number.")
 
 
(defvar *sample-nodes* #(leaf + leaf - leaf * leaf leaf)
  "Sample nodes: a leaf, +, -, /, and *
  The leafs are the elements of sample-values, and have an equal
  chance of appearing as a node does.")
 
  
(defun sample-generate-leaf (array)
  "Picks a random element from 'list' and translates it into the proper atom
  or list."
  (let ((elt (random-array-element array)))
    (case elt
        (randomnum (random 1024))
        (randomfrac
         (/ (random 1024) (+ (random 1024) 1)))
        (t elt))))
 
 
(defun sample-rule-fun ()
  "Example random rule generator. Generates a random arithmetical
  expression."
  (labels ((sample-helper ()
             (let ((elt (random-array-element *sample-nodes*)))
               (case elt
                 (leaf (sample-generate-leaf *sample-values*))
                 (t
                  (append (list elt)
                          (at-least-once #'sample-helper)))))))
    (let ((ret (sample-helper)))
      (if (atom ret)
          (sample-rule-fun)
          (append ret (list 'genesis::num))))))
    
 
(defun sample-fitness-function (rules)
  "Evaluates made-rules by the sum of the squared error of the
  integer square roots less than 100"
  (catch 'abort
    (let ((sqr-err 0))
      (dotimes (i 100)
        (let ((res (genesis:funcall-rules rules i)))
          (when (null res)
            (throw 'abort 99999999999))
          (incf sqr-err (expt (- i (* res res)) 2))))
      sqr-err)))
 
 
(defun square-root-sample (generations population-size)
  "Runs a genetic algorithm to find an approximation to the square root for
  integers in the range [0, 100]. The approximation normally turns out to be
  nearly linear."
  (genesis:genetic-algorithm generations nil #'sample-rule-fun
                             #'sample-fitness-function
                             :population-size population-size))