;;; -*- 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-boolean-majority-fitness (individual)
  (bind ((lisp-form (hu.dwim.genetic-programming::individual-lisp-form individual))
         (fitness 0))
    (map-product (lambda (a b c d e)
                   (bind ((real-result (> (count t (list a b c d e)) 2))
                          (approximated-result (bind ((sb-ext::*evaluator-mode* :interpret))
                                                 (eval (list 'funcall lisp-form a b c d e)))))
                     (incf fitness (if (eq real-result approximated-result)
                                       0
                                       1))
                     (values)))
                 '(nil t) '(nil t) '(nil t) '(nil t) '(nil t))
    fitness))

(def test test/boolean-majority (&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 'boolean
                                                                                                                  :argument-names '(a b c d e)
                                                                                                                  :argument-types '(boolean boolean boolean boolean boolean)
                                                                                                                  :minimum-depth 3
                                                                                                                  :maximum-depth 6
                                                                                                                  :form-types '(variable-reference-form free-application-form)
                                                                                                                  :function-descriptors (collect-function-descriptors '(or and))))))
           :evolution-termination-predicate (lambda (population)
                                              (= (hu.dwim.genetic-programming::population-generation population) max-generation))
           :fitness-calculator 'compute-boolean-majority-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::count-forms (hu.dwim.genetic-programming::individual-walked-form individual)
                                                                                                                   hu.dwim.genetic-programming::+rewritable-form-types+)
                                                                         100)))))
                                  (subseq individuals 0 max-population)))
           :reproduction-function (lambda (population)
                                    (reproduce-individuals population (floor (/ max-population 10)))))))

;;;;;;
;;; Specialized or/10, and/3

(def function and/3 (a b c)
  (and a b c))

(def function-descriptor and/3 (boolean boolean boolean) boolean)

(def function or/10 (a b c d e f g h i j)
  (or a b c d e f g h i j))

(def function-descriptor or/10 (boolean boolean boolean boolean boolean boolean boolean boolean boolean boolean) boolean)

(def (function e) make-random-free-application-form/boolean-majority (&rest args &key maximum-depth &allow-other-keys)
  (bind ((bottom? (= maximum-depth 0))
         (function-descriptor (find-function-descriptor (if bottom? 'and/3 'or/10)))
         (argument-types (hu.dwim.genetic-programming::function-descriptor-argument-types function-descriptor))
         (argument-forms (mapcar (lambda (argument-type)
                                   (apply 'generate-form
                                          :return-type argument-type
                                          :form-types (if bottom? '(variable-reference-form) '(free-application-form))
                                          args))
                                 argument-types)))
    (make-instance 'free-application-form
                   :attributes args
                   :operator (hu.dwim.genetic-programming::function-descriptor-name function-descriptor)
                   :arguments argument-forms)))

(def test test/boolean-majority/3 (&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 :free-application-form-generator 'make-random-free-application-form/boolean-majority)
                                                                                                                  :return-type 'boolean
                                                                                                                  :argument-names '(a b c d e)
                                                                                                                  :argument-types '(boolean boolean boolean boolean boolean)
                                                                                                                  :minimum-depth 2
                                                                                                                  :maximum-depth 2
                                                                                                                  :form-types '(variable-reference-form free-application-form)
                                                                                                                  :function-descriptors (collect-function-descriptors '(or/10 and/3))))))
           :evolution-termination-predicate (lambda (population)
                                              (= (hu.dwim.genetic-programming::population-generation population) max-generation))
           :fitness-calculator 'compute-boolean-majority-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::count-forms (hu.dwim.genetic-programming::individual-walked-form individual)
                                                                                                                   hu.dwim.genetic-programming::+rewritable-form-types+)
                                                                         100)))))
                                  (subseq individuals 0 max-population)))
           :reproduction-function (lambda (population)
                                    (reproduce-individuals population (floor (/ max-population 10)))))))