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

#|

Notes:

- To run this you must:
  - load the lgp system
  - load calc.lisp (calc-interface.lisp isn't required)
  - load this file
  - evaluate (evolve)

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

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

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

|#


(setq *gp-params*
  '((*instruction-generators*
     (
      (list 'CALC-0)
      (list 'CALC-1)
      (list 'CALC-2)
      (list 'CALC-3)
      (list 'CALC-4)
      (list 'CALC-5)
      (list 'CALC-6)
      (list 'CALC-7)
      (list 'CALC-8)
      (list 'CALC-9)
      (list 'CALC-.)
      (list 'CALC-ENTER)
      (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* 100)
    (*selection-tournament-size* 3)
    (*best-individual* ((999999999999999999 999999999999999999) nil))
    (*halting-fitness* (0 5)) ;; fitness lists are (error length)
    (*report-every* 100)
    (*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) 
    ))
|#
#|
(defparameter *calculator-fitness-cases*
  ;; each case is of the form (A B Answer)
  '(
    (16 0 0) 
    (4 13 13) 
    (13 10 100) 
    (9 9 54) 
    (3 13 0) 
    (18 3 45) 
    (0 19 -57) 
    (8 7 35) 
    (0 9 -27) 
    (15 15 180) 
    (18 18 270) 
    (11 10 80) 
    (14 5 55) 
    (7 10 40) 
    (8 19 95) 
    (9 5 30) 
    (4 11 11) 
    (15 2 24) 
    (16 10 130) 
    (16 18 234) 
    ))
|#

(defparameter *calculator-fitness-cases*
  ;; each case is of the form (A B Answer)
  '(
    (0.0 0 0.0) 
    (0.125 0 0.140625) 
    (0.25 0 0.3125) 
    (0.375 0 0.515625) 
    (0.5 0 0.75) 
    (0.625 0 1.015625) 
    (0.75 0 1.3125) 
    (0.875 0 1.640625) 
    (1.0 0 2.0) 
    (1.125 0 2.390625) 
    (1.25 0 2.8125) 
    (1.375 0 3.265625) 
    (1.5 0 3.75) 
    (1.625 0 4.265625) 
    (1.75 0 4.8125) 
    (1.875 0 5.390625) 
    (2.0 0 6.0) 
    (2.125 0 6.640625) 
    (2.25 0 7.3125) 
    (2.375 0 8.015625) 
    ))

(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)