;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; calc-fast-evolve.lisp -- code linking lgp.lisp and calc-fast.lisp
;; to evolve programs for a simulated stack-based calculator
;;
;; c) 1999, Lee Spector
;;
;; version 1.19990330 (n.yyyymmdd)

#|

This is a version of calc-evolve.lisp that works with calc-fast.lisp
rather than calc.lisp. See the code for an example of how to introduce
(random) numerical constants in evolving programs.

Notes:

- To run this you must:
  - load the lgp system
  - load calc-fast.lisp
  - load this file
  - evaluate (evolve)

- This is set up to solve symbolic regression problems with the
  stack-based calculator in calc-fast.lisp.

- Fitness cases (data for the regression) are listed in 
  *calculator-fitness-cases* (see below).

- Fitness values are of the form (error program-length).

|#


(defparameter *random-constant-magnitude-limit* 10
  "Defines a limit on the size of random constants that will
be generated for inclusion in evolving calc-fast programs.
For example if this is 10 then all random constants will
be in the range from -10 to 10, exclusive.")

(defun plus-or-minus (n)
  "Returns n, possibly negated."
  (if (zerop (randint 2))
    (- n)
    n))

(defun random-integer-constant-form ()
  "Returns a form which, when evaluated, pushes a particular
integer constant onto the calc-fast stack. The constant is chosen
when random-integer-constant-form is called -- from that
point onward it is constant."
  (list 'push-stack
        (plus-or-minus (randint *random-constant-magnitude-limit*))))

(defun random-float-constant-form ()
  "Returns a form which, when evaluated, pushes a particular
floating point constant onto the calc-fast stack. The constant is chosen
when random-integer-constant-form is called -- from that
point onward it is constant."
  (list 'push-stack
        (plus-or-minus 
         (random::random-float *random-constant-magnitude-limit*))))

(setq *gp-params*
  '((*instruction-generators*
     ((random-integer-constant-form)
      (random-float-constant-form)
      (list 'CALC-+)
      (list 'CALC--)
      (list 'CALC-*)
      (list 'CALC-/)
      (list 'CALC-SQRT)
      (list 'CALC-CHS)
      (list 'CALC-SQ)
      (list 'CALC-X^Y)
      (list 'CALC-ABS)
      (list 'CALC-PI)
      (list 'CALC-E)
      (list 'CALC-LN)
      (list 'CALC-SIN)
      (list 'CALC-COS)
      (list 'CALC-TAN)
      (list 'CALC-1/X)
      (list 'CALC-A)
      (list 'CALC-B)
      (list 'CALC-X<->Y)
      ))
    (*genetic-operators* 
     (
      reproduction 
      crossover
      mutation 
      insertion 
      mutant-insertion 
      deletion
      calculator-minimization
      ))
    (*population-size* 10000)
    (*selection-tournament-size* 3)
    (*best-individual* ((999999999999999999 999999999999999999) nil))
    (*halting-fitness* (0 5)) ;; fitness lists are (error length)
    (*report-every* 10000)
    (*max-initial-program-length* 5)
    (*max-program-length* 20)
    (*random-seeds* (0 0))
    (*lexicographic-fitness-epsilon* 0.00001)
    (*initialization-forms* nil)
    (*percent-losers-win* 10)
    ))

(defparameter *calculator-fitness-cases*
  ;; each case is of the form (A B Answer)
  '(
    (0.0 0 0.0) 
    (0.05 0 0.007853981633974483) 
    (0.1 0 0.031415926535897934) 
    (0.15 0 0.07068583470577035) 
    (0.2 0 0.12566370614359174) 
    (0.25 0 0.19634954084936207) 
    (0.3 0 0.2827433388230814) 
    (0.35 0 0.38484510006474965) 
    (0.4 0 0.5026548245743669) 
    (0.45 0 0.6361725123519332) 
    (0.5 0 0.7853981633974483) 
    (0.55 0 0.9503317777109126) 
    (0.6 0 1.1309733552923256) 
    (0.65 0 1.3273228961416876) 
    (0.7 0 1.5393804002589986) 
    (0.75 0 1.7671458676442586) 
    (0.8 0 2.0106192982974678) 
    (0.85 0 2.2698006922186256) 
    (0.9 0 2.5446900494077327) 
    (0.95 0 2.8352873698647882) 
    ))

(defun calculator-minimization ()
  "A minimization operator for the calculator application."
  (minimization #'calculator-fitness))

(defun calculator-fitness (program)
  "Evaluates the fitness of the given calculator program
using *calculator-fitness-cases*"
  (let ((total-error 0)
        (crashed nil)
        (huge-num 9999999999999999999999))
    (dolist (case *calculator-fitness-cases*)
      (calc-clear)
      (calc-set-a (first case))
      (calc-set-b (second case))
      (when (null (ignore-errors (progn (execute-program program) t)))
        (setq crashed t))
      (let ((result (if crashed 0 (min (calc-answer) huge-num))))
        (incf total-error
              (abs (- result (third case))))))
    (list (if crashed huge-num total-error)
          (length program))))

(defun calculator-fitness-computed-if-necessary (individual)
  "If the fitness of the individual has already been computed then this
just returns it. Otherwise calculator-fitness is called on the individual's
program and the result is returned."
  (if (eq (first individual) :no-computed-fitness)
    (calculator-fitness (second individual))
    (first individual)))

(defun replacement-tournament (individual1 individual2)
  "Returns winner. Sets *best-individual* if appropriate."
  (let* ((program1 (second individual1))
         (program2 (second individual2))
         (fitness-list1 (calculator-fitness-computed-if-necessary individual1))
         (fitness-list2 (calculator-fitness-computed-if-necessary individual2))
         winner
         loser
         (new-best nil))
    (if (lexicographically-better-fitness fitness-list1 fitness-list2)
      (progn (setq winner (list fitness-list1 program1))
             (setq loser (list fitness-list2 program2)))
      (progn (setq winner (list fitness-list2 program2))
             (setq loser (list fitness-list1 program1))))
    (when (lexicographically-better-fitness
           (first winner) (first *best-individual*))
      (setq new-best t)
      (setq *best-individual* winner))
    ;; return value
    (cond (new-best winner) ;; always return winner if it's a new best
          ((< (randint 100) *percent-losers-win*)
           loser)
          (t winner))))

;; (evolve)