;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; evolve-image.lisp
;; Code linking lgp and compare-drawings.lisp, for evolving images
;; c) Lee Spector, 1999
;; lspector@hampshire.edu
;;
;; version 1.19990405 (n.yyyymmdd)
;;
;; To use: load the lgp system, compare-drawings.lisp, and this
;; and then (evolve)


(defparameter *canvas-x* 200 "The x dimension of the drawing")
(defparameter *canvas-y* 200 "The y dimension of the drawing")

(defun randint (n)
  (random::random-integer n))

(setq *gp-params*
  '((*instruction-generators*
     ((list 'draw-color-line
            (- (randint (* 2 *canvas-x*))
               (truncate *canvas-x* 2))
            (- (randint (* 2 *canvas-y*))
               (truncate *canvas-y* 2))
            (- (randint (* 2 *canvas-x*))
               (truncate *canvas-x* 2))
            (- (randint (* 2 *canvas-y*))
               (truncate *canvas-y* 2))
            (randint 65536)
            (randint 65536)
            (randint 65536))
      (list 'draw-color-rectangle
            (- (randint (* 2 *canvas-x*))
               (truncate *canvas-x* 2))
            (- (randint (* 2 *canvas-y*))
               (truncate *canvas-y* 2))
            (randint *canvas-x*)
            (randint *canvas-y*)
            (randint 65536)
            (randint 65536)
            (randint 65536))
      (list 'draw-color-oval
            (- (randint (* 2 *canvas-x*))
               (truncate *canvas-x* 2))
            (- (randint (* 2 *canvas-y*))
               (truncate *canvas-y* 2))
            (randint *canvas-x*)
            (randint *canvas-y*)
            (randint 65536)
            (randint 65536)
            (randint 65536))))
    (*genetic-operators* (reproduction crossover mutation))
    (*population-size* 25)
    (*selection-tournament-size* 5)
    (*best-individual* ((1 1) nil)) ; can preload best from before
    (*halting-fitness* (0 0))
    (*report-every* 0)
    (*max-initial-program-length* 100)
    (*max-program-length* 250)
    (*random-seeds* (0 0))
    (*initialization-forms* nil)
    ))


(defun replacement-tournament (individual1 individual2)
  "Returns winner. Sets *best-individual* if appropriate."
  (let* ((program1 (second individual1))
         (program2 (second individual2)))
    (init-draw-windows *canvas-x* *canvas-y*)
    (setq *which-drawing* 1)
    (execute-program program1)
    (setq *which-drawing* 2)
    (execute-program program2)
    (case (wait-for-drawing-choice)
      (1 individual1)
      (2 individual2))))
      
;; (evolve)