;; AI Final Project
;; Module: Genetics-Population & Copying
;; CSC 466 - Graci
;; Jacob Peck - 20110330

; for verbose demos, set to T
(setf *DEMO* NIL)

(defclass population ()
  (
    (individuals :accessor population-individuals :initarg :individuals :initform '())
    ; individuals is a list of the individuals
    (generation :accessor population-generation :initarg :generation :initform 0)
    ; generation number, for logging/determining the end of evolution
    (mutation :accessor population-mutation :initarg :mutation :initform 'NIL)
    ; the mutation operator function for the current implementation
    (crossover :accessor population-crossover :initarg :crossover :initform 'NIL)
    ; the crossover operator function for the current implementation
    (chance-copy :accessor population-chance-copy :initarg :chance-copy :initform 40)
    ; % chance that an individual will be copied
    (chance-mutate :accessor population-chance-mutate :initarg :chance-mutate :initform 20)
    ; % chance that an individual will be crossed over
    (chance-crossover :accessor population-chance-crossover :initarg :chance-crossover :initform 40)
    ; % chance that an individual in a new population will be a crossover individual
 )
)

(defmethod make-population ((ind list) (gen integer) (mut function) 
                            (cross function) (copyc integer) (mutatec integer) 
                            (crossc integer))
  (make-instance 'population :individuals ind :generation gen :mutation mut
                             :crossover cross :chance-copy copyc 
                             :chance-mutate mutatec :chance-crossover crossc)
)

(defmethod add-individual ((pop population) (ind individual))
  (setf (population-individuals pop) (append (population-individuals pop) (list ind)))
  NIL
)

(defmethod average-fitness ((pop population) &aux ind avg count)
  (setf ind (population-individuals pop))
  (setf count (length ind))
  (setf avg 0)
  (dolist (element ind NIL)
    (setf avg (+ avg (individual-fitness element)))
  )
  (float (/ avg count))
)

(defmethod visualize-population ((pop population) &aux ind)
  (setf ind (population-individuals pop))
  (format t "Population ~A:~%" (population-generation pop))
  (dolist (element ind NIL)
    (visualize-individual element)
  )
  (format t "Average fitness: ~A~%" (average-fitness pop))
)

(defmethod select-individuals ((pop population) &aux nr-pick ind selected temp)
  (setf ind (population-individuals pop))
  ; 10% of the population, rounded up to an int
  (setf nr-pick (ceiling (* (length ind) .1)))
  (setf selected '())
  (if *DEMO* (format t "Selected individuals:~%"))
  (dotimes (i nr-pick NIL)
    (loop do
      (setf temp (pick ind))
    until (null (member temp selected)))  ; guarantees unique individuals are selected
    (setf selected (append selected (list temp)))
    (if *DEMO* (visualize-individual temp))
  )
  selected
)

(defmethod select-individual ((pop population) &aux best)
  (setf candidates (select-individuals pop))
  (setf best (first candidates))
  (dolist (element candidates NIL)
    (if (> (individual-fitness element) (individual-fitness best))
        (setf best element)
    )
  )
  (if *DEMO* (progn (format t "Best candidate:~%") (visualize-individual best)))
  best
)

(defmethod perform-copies ((pop population) &aux nr-copies newinds newinds2 ind temp newpop)
  (if *DEMO* (format t "~%~%  Performing copies~%"))
  (setf ind (population-individuals pop))
  (setf newinds '())
  (setf newinds2 '())
  (setf nr-copies (ceiling (* (length ind) (float (/ (population-chance-copy pop) 100)))))
  (if *DEMO* (format t " doing ~A copies~%" nr-copies))
  (dotimes (i nr-copies NIL)
    (loop do
      (setf temp (select-individual pop))
    until (null (member temp newinds)))
    (setf newinds (append newinds (list temp)))
  )
  (dotimes (i nr-copies NIL)
    ; copy and renumber individuals
    (setf temp (copy-individual (nth i newinds)))
    (setf (individual-name temp) (+ 1 i))
    (setf newinds2 (append newinds2 (list temp)))
  )
  (setf newpop (make-population newinds2 (+ 1 (population-generation pop))
                (population-mutation pop) (population-crossover pop)
                (population-chance-copy pop) (population-chance-mutate pop)
                (population-chance-crossover pop)))
  newpop
)

(defmethod next-generation ((pop population) &aux newpop)
  (setf newpop (perform-copies pop))
  (apply (population-mutation pop) (list pop newpop))
  (apply (population-crossover pop) (list pop newpop))
  (if *DEMO* (progn (format t "New population:~%") (visualize-population newpop)))
  newpop
)