;;; This file contains a patch that allows the GP implementation
;;; in Koza's book "Genetic Programming - On the Programming
;;; of Computers by Means of Natural Selection" to support a
;;; more general form of tournament selection.

;;; The first function below is the function to remove from Koza's
;;; source code.  It should be replaces using the rest of the code below.


;==============================================================================
;;; Replace the function:

(defun find-individual-using-tournament-selection (population)
  "Picks two individuals from the population at random and
   returns the better one."
  (let ((individual-a
          (aref population 
                (random-integer (length population))))
        (individual-b
          (aref population 
                (random-integer (length population)))))
    (if (< (individual-standardized-fitness individual-a)
           (individual-standardized-fitness individual-b))
        (individual-program individual-a)
        (individual-program individual-b))))

;==============================================================================
;;; with the following definition:

(defparameter *tournament-size* 7)

(defun pick-k-random-individual-indices (k max)
  (let ((numbers nil))
    (loop for number = (random-integer max)
	  unless (member number numbers :test #'eql)
	  do (push number numbers)
	  until (= (length numbers) k))
    numbers))

(defun find-individual-using-tournament-selection (population)
  "Picks *tournament-size* individuals from the population at random and
   returns the best one."
  (let ((numbers (pick-k-random-individual-indices
		   *tournament-size* (length population))))
    (loop with best = (aref population (first numbers))
	  with best-fitness = (individual-standardized-fitness best)
	  for number in (rest numbers)
	  for individual = (aref population number)
	  for this-fitness = (individual-standardized-fitness individual)
	  when (< this-fitness best-fitness)
	  do (setf best individual)
	     (setf best-fitness this-fitness)
	  finally (return (individual-program best)))))