Clementson's Blog

Genetic Programming in Common Lisp

Saturday, June 19, 2004

I've been interested in Genetic Programming off and on over the past few years. Basically, GP uses evolutionary search (e.g. - the Darwinian principle of natural selection or survival of the fittest) to generate (and mutate) code programmatically. Although one might not think that "evolving" code is practical, in practice, GP is quite effective for certain types of problems. In particular, John Koza's books have been very useful in showing me how GP can solve a range of different types of problems in Lisp. Lee Spector also has some GP code in Lisp on his site as well as a new book on using GP for Quantum Computing.

Oh well, enough talking, let's see some code! I decided to see how Koza's GP code would do at "evolving" code to "discover" the formula for calculating the area of a circle (e.g. - PIr**2). The necessary steps I followed were:

• Decide the constants and variables that will be considered (in this case, I chose radius, PI, and a random number).
• Decide the range of operations that will be used (I selected the standard arithmetic operations: addition, subtraction, multiplication and division).
• Create the fitness cases (e.g. - radius values and area values) that represent correct solutions (since I already knew the correct formula, I used it to provide the correct solutions; however, if I hadn't known the formula, I could have manually calculated the areas for the given radii).
• Create the evaluation function that determines what constitutes a good result (in this case, the result had to match the actual area of the circle or be pretty close to it).
• Define the termination criteria (in this case, the program is terminated if:
  • There is a match with the generated function on all of the fitness case values
  OR
  • The maximum number of tests for the run is hit.

;=========================================================================
;;; Discovering a formula for the area of a circle

(defvar r)

(defun define-terminal-set-for-AREA-CIRCLE ()
  (values '(r pi :floating-point-random-constant)))

(defun define-function-set-for-AREA-CIRCLE ()
  (values '(+ - * %)
          '(2 2 2 2)))

(defstruct AREA-CIRCLE-fitness-case
  independent-variable
  target)

(defun define-fitness-cases-for-AREA-CIRCLE ()
  (let (fitness-cases r this-fitness-case) 
    (setf fitness-cases (make-array *number-of-fitness-cases*))	
    (format t "~%Fitness cases")	
    (dotimes (index *number-of-fitness-cases*) 
      (setf r (/ index *number-of-fitness-cases*)) 
      (setf this-fitness-case (make-AREA-CIRCLE-fitness-case)) 
      (setf (aref fitness-cases index) this-fitness-case) 
      (setf (AREA-CIRCLE-fitness-case-independent-variable 
             this-fitness-case)         
              r)                        
      (setf (AREA-CIRCLE-fitness-case-target 
             this-fitness-case)         
              (* pi r r))               
      (format t "~% ~D      ~D      ~D"	
              index                     
              (float r)                 
              (AREA-CIRCLE-fitness-case-target this-fitness-case)))                                 
    (values fitness-cases)))

(defun AREA-CIRCLE-wrapper (result-from-program)
  (values result-from-program))

(defun evaluate-standardized-fitness-for-AREA-CIRCLE 
       (program fitness-cases)          
  (let (raw-fitness hits standardized-fitness r target-value 
                    difference value-from-program this-fitness-case) 
    (setf raw-fitness 0.0)              
    (setf hits 0)                       
    (dotimes (index *number-of-fitness-cases*) 
      (setf this-fitness-case (aref fitness-cases index)) 
      (setf r                           
              (AREA-CIRCLE-fitness-case-independent-variable 
               this-fitness-case))	
      (setf target-value                
              (AREA-CIRCLE-fitness-case-target 
               this-fitness-case))	
      (setf value-from-program          
              (AREA-CIRCLE-wrapper (eval program))) 
      (setf difference (abs (- target-value 
                               value-from-program))) 
      (incf raw-fitness difference)	
      (when (< difference 0.01) (incf hits))) 
    (setf standardized-fitness raw-fitness) 
    (values standardized-fitness hits)))                                     

(defun define-parameters-for-AREA-CIRCLE ()
  (setf *number-of-fitness-cases* 10)
  (setf *max-depth-for-new-individuals* 6)
  (setf *max-depth-for-individuals-after-crossover* 17)
  (setf *fitness-proportionate-reproduction-fraction* 0.1)
  (setf *crossover-at-any-point-fraction* 0.2)
  (setf *crossover-at-function-point-fraction* 0.2)
  (setf *max-depth-for-new-subtrees-in-mutants* 4)
  (setf *method-of-selection* :fitness-proportionate)
  (setf *method-of-generation* :ramped-half-and-half)
  (values))

(defun define-termination-criterion-for-AREA-CIRCLE 
       (current-generation              
        maximum-generations             
        best-standardized-fitness	
        best-hits)                      
  (declare (ignore best-standardized-fitness)) 
  (values                               
   (or (>= current-generation maximum-generations) 
       (>= best-hits *number-of-fitness-cases*))))                                     

(defun AREA-CIRCLE ()
  (values 'define-function-set-for-AREA-CIRCLE
          'define-terminal-set-for-AREA-CIRCLE
          'define-fitness-cases-for-AREA-CIRCLE
          'evaluate-standardized-fitness-for-AREA-CIRCLE
          'define-parameters-for-AREA-CIRCLE
          'define-termination-criterion-for-AREA-CIRCLE))

1. Download the GP code from Koza's first book and load it into your CL implementation.
2. Load the above "Area of a Circle" GP code into your CL implementation.
3. Run the following:

   (run-genetic-programming-system 'AREA-CIRCLE 1.0 31 200)

The best-of-run individual program for this run was found on 
generation 10 and had a standardized fitness measure of 0.0d0 and 10 hits.  
It was:
    (* (* PI R) R)