;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.genetic-programming.test)

(def function compute-quadratic-fitness (individual)
  (iter (with lisp-form = (hu.dwim.genetic-programming::individual-lisp-form individual))
        (for value :from -1.0 :to 1 :by 0.01)
        (for real-result = (+ (* value value) value 1))
        (for approximated-result = (bind ((sb-ext::*evaluator-mode* :interpret))
                                     (eval `(funcall ,lisp-form ,value))))
        (summing (abs (- real-result approximated-result)))))

(def test test/quadratic (&key (max-population 100) (max-generation 10000))
  (population-best-individual
   (evolve :initial-population-generator (lambda ()
                                           (make-random-population :individual-count max-population
                                                                   :lambda-form-generator (lambda ()
                                                                                            (generate-lambda-form :generator (make-generator)
                                                                                                                  :return-type 'number
                                                                                                                  :argument-names '(n)
                                                                                                                  :argument-types '(number)
                                                                                                                  :minimum-depth 1
                                                                                                                  :maximum-depth 6
                                                                                                                  :form-types '(constant-form variable-reference-form free-application-form)
                                                                                                                  :function-descriptors (collect-function-descriptors '(+ *))))))
           :evolution-termination-predicate (lambda (population)
                                              (= (hu.dwim.genetic-programming::population-generation population) max-generation))
           :fitness-calculator 'compute-quadratic-fitness
           :fitness-sort-predicate #'<
           :population-printer 'print-best-individual
           :survivor-selector (lambda (population)
                                (bind ((individuals (hu.dwim.genetic-programming::population-individuals population)))
                                  (sort individuals #'< :key (lambda (individual)
                                                               (if (hu.dwim.genetic-programming::individual-erroneous individual)
                                                                   most-positive-fixnum
                                                                   (* (hu.dwim.genetic-programming::individual-fitness individual)
                                                                      (hu.dwim.genetic-programming::individual-age individual)
                                                                      (bind ((x (hu.dwim.genetic-programming::count-forms (hu.dwim.genetic-programming::individual-walked-form individual)
                                                                                                                          hu.dwim.genetic-programming::+rewritable-form-types+)))
                                                                        (* x x))))))
                                  (subseq individuals 0 max-population)))
           :reproduction-function (lambda (population)
                                    (reproduce-individuals population (floor (/ max-population 10)))))))