;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pushgp.lisp ;; a genetic programming system that evolves programs in the push ;; programming language ;; c) 2000-2001, Lee Spector (lspector@hampshire.edu) ;; ;; distribution location: http://hampshire.edu/lspector/push.html ;; for version information see revision history below #| The basic concepts of the Push programming language are outlined in: Spector, L. 2001. Autoconstructive Evolution: Push, PushGP, and Pushpop. In Spector, L., E. Goodman, A. Wu, W.B. Langdon, H.-M. Voigt, M. Gen, S. Sen, M. Dorigo, S. Pezeshk, M. Garzon, and E. Burke, editors, Proceedings of the Genetic and Evolutionary Computation Conference, GECCO-2001. San Francisco, CA: Morgan Kaufmann Publishers. More detail, including a Push language reference, can be found in the (currently in press) journal article: Spector, L., and A. Robinson. 2002. Genetic Programming and Autoconstructive Evolution with the Push Programming Language. Genetic Programming and Evolvable Machines. Volume 3, Number 1. The comments in this file assume familiarity with the language as described in the above publications and with the comments in push.lisp. PushGP is a simple approximation to a Koza-style genetic programming system that evolves programs in the Push programming language. This code is written in Common Lisp. It has been tested in Macintosh Common Lisp and CMU Common Lisp, and it should work unchanged in any modern Common Lisp environment. (The optional code included for distributing runs across a networked cluster of computers requires CMU Common Lisp, but changing this for other Lisps should be trivial.) This distribution also contains a README file that you should read before proceeding, particularly if you are new to Lisp. This code is being made available for non-commercial educational and research uses only. To Use ------ 0. Finish reading this comment. 1. Compile/load random.cl (a seedable random number generator by Chris McConnell). 2. Compile/load push.lisp, possibly with modification (e.g. to types/instructions). Read the comments in push.lisp if you really want to understand what's going on. 3. Compile/load this file. The last thing this will do is to evaluate (pushgp), which runs pushgp on the default example (symbolic regression of y = 5x^2+x-2). Miscellaneous Notes ------------------- There many parameters that can be changed; see the "push parameters" and "pushgp globals and parameters" sections in the code below. There are several other examples at the end of the file. To try one: a) Comment out the definitions of *FITNESS-CASES* and FITNESS for the default example. b) Uncomment/evaluate definitions for *FITNESS-CASES* and FITNESS for another example. c) Reload/run (steps 1-3). Lisp programmers should be able to add definitions of *FITNESS-CASES* and FITNESS for new problems. A fitness function must take a program as an argument and return an array of *number-of-fitness-cases* numerical errors. "Fitness" and "total error" are used synonymously in many places (and lower fitnesses are always considered better). Be sure that you know how to get your Lisp environment to run this code compiled. If you run it interpreted (rather than compiled) then it will be very slow. Simplicity was one of the primary goals in this implementation. The intention was to demonstrate the potential of genetic programming with Push, not to produce a GP system with all of the bells and whistles that have been described in the literature. On the other hand, the simplicity of this code should make it relatively easy to add new features. Size pressure is an experimental bloat-control feature that can be turned off by specifying a *size-pressure* value of 1 (the default value). See the comments near the size pressure parameters for more details. For the integer regression examples (and for other problems) you might want to eliminate floats or other types along with certain instructions (e.g. RAND) by editing push.lisp. The full set of types/instructions is probably overkill for many problems, and the inclusion of useless types/instructions will probably hurt performance. On the other hand, seemingly unnecessary types can sometimes be used to surprising advantage, as described in the GECCO-2001 paper. See the comments in push.lisp for more details on turning types on/off. Three kinds of mutation are implemented: sub-expression replacement, instruction/constant perturbation, and "fair" mutation in which a subprogram is replaced with a new subprogram of approximately the same size (controlled by a parameter). Although you can set the overall mutation rate, the probability of the system applying any particular type of mutation on any particular occasion is divided evenly among the mutation operators that you list in *MUTATION-OPERATORS*. Hack the definition of MUTATE-PROGRAM if you want more control. Similarly, three kinds of crossover are implemented: sub-expression swapping, uniform instruction/constant crossover, and "fair" crossover. Although you can set the overall crossover rate, the probability of the system applying any particular type of crossover on any particular occasion is divided evenly among the mutation operators that you list in *CROSSOVER-OPERATORS*. Hack the definition of CROSSOVER-PROGRAMS if you want more control. Raphael Crawford-Marks developed the "fair" operators for PushGP and Lee Spector re-implemented them for integration into this distribution. The concept of fair mutation was, to the best of our knowledge, first developed by Langdon, Soule, Poli, and foster in: Langdon, W.B, T. Soule, R. Poli, and J.A. Foster. 1999. The Evolution of Size and Shape. In Advances in Genetic Programming, Volume 3, edited by L. Spector, U.-M. O'Reilly, W. Langdon, and P. Angeline, pp. 163-190. Cambridge, MA: MIT Press. This file includes code for distribution of PushGP runs across a networked cluster of computers with a common mounted filesystem. The distribution scheme is "independent runs with migration" -- a PushGP run is initiated on each machine and migrants are periodically written to and read from the shared filesystem. As long as the amount of migration is kept low and the network bandwidth is reasonable the performance cost for this scheme is usually low (even though it uses relatively slow filesystem operations). The default configuration of this distribution is for a non-clustered environment. If you want to run PushGP across a cluster then you'll have to do a bit more work to set it up. I use an different loader file for cluster runs; it sets *CLUSTER* to T and defines the necessary paths to the shared filesystem (and also compiles/loads all of the necessary files). If you want help setting this up then please contact me. The current cluster code also assumes you are running CMU Common Lisp and that your nodes follow a naming scheme like "n1", "n2", etc., but it shouldn't be too hard to work around this. PushGP output is sent both to the terminal and to the file specified in *PUSHGP-OUTPUT-PATH*. The default is to send output to a file called pushgp-output in the default directory. (In MCL thee default directory is the application directory; in most other Lisps it is the directory that was current when Lisp was launched.) Set *PUSHGP-OUTPUT-PATH* to NIL if you don't want any file output. If *PRODUCE-CHART-OUTPUT* is non-nil then PushGP also writes the current best fitness to a file (with a default name of "chart/bestfit"; you must make sure that there's a "chart/" directory in the appropriate place or change the path information in CHART-OUT). This is intended for use with the gstripchart-plotter program that is available in Linux environments. This provides a simple way to visually monitor the progress of a PushGP run. If you need help configuring gstripchart-plotter for use with PushGP please contact me. (If you are running PushGP in a clustered environment I can give you a configuration file to monitor all of the runs on a single machine, which is particularly nice). It is straightforward to add code to visually monitor other features of a PushGP run using the same mechanism (see how CHART-OUT is used below). If you use CMU Common Lisp you can cut down the number of garbage collection messages and improve efficiency by including something like: #+cmu(setq extensions:*bytes-consed-between-gcs* 100000000) If you get warnings that this is too large you might remove one of the zeros. To turn off all of the garbage collection messages use: #+cmu(setq extensions:*gc-verbose* nil) To Do ----- - Reconsider random name generation scheme. Push's &RANDNAME can generate huge numbers of names if RAND is implemented for the NAME type, leading quickly to memory problems. Revision History ---------------- YYYYMMDD 20010205 - First revision for limited distribution. 20010206 - Revised examples to penalize nontermination. - Changed default values of many parameters. - Uncommented regression example so this will run if no changes are made. 20010210 - Added *max-generations*, *halting-fitness*, and end-of-run messages. 20010306 - Added copy-tree to crossover-programs, in an effort to avoid the creation of circular lists. 20010531 - Cluster code and cluster/non-cluster conditionalization. - Fixed off-by-1 bug in printed success generation (per suggestion of Alan Robinson) - Changed output format for total errors report, to work with cluster-related scripts. - Added chart output code for use with gstripchart-plotter. - Added code for even-n-parity problem. 20010601 - Added code to generate parity cases instead of hand-coding them. 20010606 - Added code for primep problem. 20010608 - Report numbers of ERC and RAND-generated variables. - Changed "Report at" line to allow summarization with allmax tool. 20010611 - Added code for even-n-parity with garbage bits problem. 20010612 - Added migration for cluster. - Fixed even-n-parity/garbage to push garbage bits first. - Added code for even-n-parity with "LESS garbage bits" 20010627 - Extended several examples. - Added normalization code, but using it only for factorial example. 20010712 - Cleaned up for first public distribution. Many examples (including some mentioned above) moved out of this file. 20010713 - Conditionalized chart output with *produce-chart-output*. 20010715 - Added uncommented (pushgp) call to the end of the file. 20011117 - Added fair mutation (thanks to Raphael Crawford-Marks). Added *mutation-operators*, *fair-mutation-range* and *dirty-mutation-denominator* parameters. 20011118 - Added error-trapping for regression and factorial examples (can be added to the others in a similar way). 20011120 - Added fair crossover (thanks to Raphael Crawford-Marks). Added *crossover-operators*, *fair-crossover-range*, and *fair-crossover-max-attempts*. 20011129 - Revised comments for new on-line distribution. 20011224 - Minor changes to comments and defaults. |# ;; possible optimization declarations ;(declaim (optimize (speed 3) (safety 1) (space 0) (debug 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; cluster stuff ;; See comments above. (unless (boundp '*cluster*) (defparameter *cluster* nil)) ;; The host name of the particular node in the cluster -- this will ;; be prepended to output file names. (defparameter *host* (if *cluster* #+:CMU (unix:unix-gethostname) #-:CMU (error "running as cluster without CMU!") "")) ;; The directory to which output should be sent. (defparameter *out-dir* (if *cluster* *shared-dir* "")) ;; Assumes nodes are named "n1", "n2", etc. Node numbers are used both ;; for tagging output files and for seeding the random number generator ;; (so this really needs to be a positive integer). (defparameter *host-number* (if *cluster* (read-from-string (subseq *host* 1)) 1)) ;; The *host-extension* will be appended output file names. (defparameter *host-extension* (if (string-equal *host* "") "" (concatenate 'string "." *host*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; push parameters -- see documentation in push.lisp (setq *evalpush-limit* 50) (setq *enforce-evalpush-time-limit* nil) (setq *evalpush-time-limit* 0.1) (setq *max-points-in-program* 50) (setq *max-points-in-random-expressions* 50) (setq *random-seeds* (list 12 *host-number*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pushgp globals and parameters ;; parameters that should be set (defparameter *max-new-points-in-mutants* 10 "The maximum number of points that may be added by a single 'standard' mutation.") (defparameter *population-size* 2000 "The size of the genetic programming population.") (defparameter *tournament-size* 5 "The size of tournaments used in selecting individuals for reproduction, crossover, and mutation. Higher = more selective.") (defparameter *max-generations* 1000 "The maximum number of generations in a pushgp run.") (defparameter *number-of-fitness-cases* 10 "The number of inputs on which each individual will be assessed for fitness.") (defparameter *halting-fitness* 0 "If a fitness less than or equal to this value is obtained then the pushgp will halt and report success. Lower fitnesses are better.") (defparameter *mutation-probability* 0.45 "The probability that an individual in the next generation will be produced by mutation.") (defparameter *crossover-probability* 0.45 "The probability that an individual in the next generation will be produced by crossover.") (defparameter *immigration-probability* 0.005 "The probability that an individual in the next generation will be produced by immigration. If immigration fails (which can happen because of file-system errors or because pushgp is being run in a non-cluster environment) then this probability will instead be added to the probability for perfect reproduction.") ;; the probability of perfect reproduction is ;; 1.0 - *mutation-probability* - *crossover-probability* ;; - *immigration-probability* (defparameter *mutation-operators* (list ;'standard 'fair ;'perturb ) "A list of the mutation operators that will be used, each with equal probability") (defparameter *fair-mutation-range* 0.25 "The percentage of size by which the new point may differ from the old point in fair mutation.") (defparameter *dirty-mutation-denominator* 50 "The denominator for calls to dirty-copy in dirty mutation.") (defparameter *crossover-operators* (list ;'standard 'fair ;'uniform ) "A list of the crossover operators that will be used, each with equal probability") (defparameter *fair-crossover-range* 0.25 "The percentage of size by which the new point may differ from the old point in fair crossover.") (defparameter *fair-crossover-max-attempts* 10 "The maximum number of sub-programs that will be examined for replacement during a fair crossover operation, the goal being to find one sufficiently close in size to the replacement code.") (defparameter *re-evaluate-clones* nil "If this is true then cloned individuals will be re-evaluated for fitness in the next generation. If it is nil then the parent's fitness will be inherited. You probably want to re-evaluate clones if the individuals inhabit a dynamic environment or if there are nondeterministic instructions. Clones are always re-evaluated when *apply-size-pressure-to-cloning* is non-nil.") (defparameter *pushgp-output-path* (concatenate 'string *out-dir* "pushgp-output" *host-extension*) "The name of the file to which pushgp will report.") (defparameter *produce-chart-output* nil "If non-nil then 'charting' data is sent to files, presumably for plotting with gstripchart-plotter or a similar utility.") ;; size pressure parameters -- to turn off set *size-pressure* to 1 ;; When size pressure is used each genetic operator will be run multiple ;; times, producing *size-pressure* potential offspring. The single offspring ;; closest in size to *ideal-size* will be chosen from these and the others ;; will be discarded. (defparameter *size-pressure* 1 "The number of times to run each genetic operator when using size pressure. A value of 1 means no size pressure. Higher values mean more size pressure.") (defparameter *ideal-size* 25 "The ideal size for programs when using size pressure.") (defparameter *apply-size-pressure-to-cloning* nil "If non-nil then size pressure will be applied to cloning -- otherwise it will be applied only to mutation and crossover.") ;; error normalizing is currently implemented only for the factorial example (defparameter *normalize-fitnesses* nil "If non-nil then fitnesses (errors) will be normalized to [0-1] for each fitness case. This is currently implemented only for the factorial example but could be added to other problems.") ;; globals that shouldn't be set (defparameter *population* (make-array *population-size*) "The PushGP population.") (defparameter *immigrants* nil "Immigrants that may be included in the next PushGP generation.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; individuals (defstruct individual (program nil) ;; the individual's program (errors :unevaluated) ;; an array of errors, one per case (total-error :unevaluated)) ;; the sum of errors (defun random-individual () "Returns a new individual with a randomly generated program." (make-individual :program (random-code *max-points-in-random-expressions*))) (defun with-best-size (programs) "Returns the program with the 'best' size according to the size pressure parameters." (let ((size-differences nil)) (dolist (p (reverse programs)) (push (abs (- (count-points p) *ideal-size*)) size-differences)) (nth (position (apply #'min size-differences) size-differences) programs))) (defun normalize (number) "Normalizes a number to [0-1]." (if *normalize-fitnesses* (- 1.0 (/ 1 (+ 1 number))) number)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; population and genetics (defun init-population () "Initializes several globals including the pushgp population." (complete-push-configuration) ;** (setq *push-names* nil) ;** push generated variables (random::seed-state (first *random-seeds*) (second *random-seeds*)) (problem-specific-initialization) ; instruction set mods, etc., for problem (pushgp-output "~%Initializing population, size=~A..." *population-size*) (setq *population* (make-array *population-size*)) (dotimes (i *population-size*) (setf (aref *population* i) (random-individual)))) (defun problem-specific-initialization () "This can be redefined to perform problem-specific initializations." nil) (defun select-individual () "Returns an individual produced by tournament selection." (let ((tournament-set nil)) (dotimes (i *tournament-size*) (push (aref *population* (randint *population-size*)) tournament-set)) (first (sort tournament-set #'< :key #'individual-total-error)))) (defun mutant () "Returns a mutation of an individual from the current population." (let ((individual (select-individual)) (candidates nil)) (dotimes (i *size-pressure*) (push (mutate-program (individual-program individual)) candidates)) (make-individual :program (with-best-size candidates)))) (defun hybrid () "Returns an individual with a program produced by crossover of two individuals in the current population." (let ((individual1 (select-individual)) (individual2 (select-individual)) (candidates nil)) (dotimes (i *size-pressure*) (push (crossover-programs (individual-program individual1) (individual-program individual2)) candidates)) (make-individual :program (with-best-size candidates)))) (defun immigrant () "Returns an immigrant if one is available. Returns a clone otherwise." (if *immigrants* (make-individual :program (copy-tree (random-element *immigrants*))) (clone))) (defun clone () "Returns an individual cloned from one in the current population." (if *apply-size-pressure-to-cloning* (let ((candidates nil)) (dotimes (i *size-pressure*) (push (individual-program (select-individual)) candidates)) (make-individual :program (copy-tree (with-best-size candidates)))) (if *re-evaluate-clones* (make-individual :program (copy-tree (individual-program (select-individual)))) (copy-individual (select-individual))))) (defun random-code-fair (base-points) "Generates random code with number of points within a range of base-points." (let* ((range (round (* *fair-mutation-range* base-points)))) (if (zerop (randint 2)) (random-code-with-size (- base-points range)) (random-code-with-size (+ base-points range))))) (defun mutate-program (p) "Returns a mutated version of the program p." (let ((op (random-element *mutation-operators*))) (case op (standard (let ((new-program (insert-code-at-point p (randint (count-points p)) (random-code *max-new-points-in-mutants*)))) (if (> (count-points new-program) *Max-Points-In-Program*) p new-program))) (fair (let* ((mutate-point (randint (count-points p))) (new-program (insert-code-at-point p mutate-point (random-code-fair (count-points (code-at-point p mutate-point)))))) (if (> (count-points new-program) *Max-Points-In-Program*) p new-program))) (dirty (dirty-copy p *dirty-mutation-denominator*))))) (defun fair-xover-point (p size) "Returns an index into p (a push program) that indexes a sub-program of size approximately equal to size." (let* ((range (round (* *fair-crossover-range* size))) (low-size-limit (- size range)) (high-size-limit (+ size range)) (best-index 0) (best-size 0) candidate-index candidate-size (done nil)) (do ((i 0 (+ i 1))) ((or done (> i *fair-crossover-max-attempts*))) (setq candidate-index (randint size)) (setq candidate-size (count-points (code-at-point p candidate-index))) (cond ((<= low-size-limit candidate-size high-size-limit) (setq best-index candidate-index done t)) ((or (zerop best-size) (< (abs (- candidate-size size)) (abs (- best-size size)))) (setq best-index candidate-index best-size candidate-size)))) best-index)) (defun crossover-programs (p1 p2) "Returns a program produced by crossover of programs p1 and p2." (let ((op (random-element *crossover-operators*))) (case op (standard (let* ((code-to-insert (copy-tree (code-at-point p1 (randint (count-points p1))))) (new-program (insert-code-at-point p2 (randint (count-points p2)) code-to-insert))) (if (> (count-points new-program) *Max-Points-In-Program*) p2 new-program))) (fair (let* ((code-to-insert (copy-tree (code-at-point p1 (randint (count-points p1))))) (new-program (insert-code-at-point p2 (fair-xover-point p2 (count-points code-to-insert)) code-to-insert))) (if (> (count-points new-program) *Max-Points-In-Program*) p2 new-program))) (uniform (with-atoms-uniform-crossover p1 (flatten p1) (flatten p2)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; migration (defun process-migrants () "Writes emigrants to disk and reads immigrants from disk." (when *cluster* (pushgp-output "~%Conducting emigration.") (emigration) (pushgp-output "~%Conducting immigration.") (immigration) (pushgp-output " Number of immigrants: ~A" (length *immigrants*)))) (defun emigration () "Writes emigrants to disk." (let ((emigrants nil)) (dotimes (i (* *immigration-probability* *population-size*)) (push (individual-program (select-individual)) emigrants)) (with-open-file (f (concatenate 'string *out-dir* "migrants" *host-extension*) :direction :output :if-exists :overwrite :if-does-not-exist :create) (format f "~A" emigrants)))) (defun immigration () "Reads immigrants from disk." (let* ((available-files (directory (concatenate 'string *out-dir* "migrants*"))) (chosen-file (random-element available-files)) (result (ignore-errors (with-open-file (f chosen-file :direction :input :if-does-not-exist nil) (when f (setq *immigrants* (read f))))))) (unless result (setq *immigrants* nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; output (defun chart-out (chart val) "Writes a value (val) to a file with the specified name (chart) in the chart/ directory. Overwrites any pre-existing file/value." (when *produce-chart-output* (with-open-file (out (concatenate 'string *out-dir* "chart/" chart *host-extension*) :direction :output :if-exists :supersede :if-does-not-exist :create) (format out "~A" (float val))))) (defun pushgp-output (&rest format-args) "Interprets its arguments as FORMAT does (without a stream argument) and sends the output both to standard output (e.g. the terminal) and, if *pushgp-output-path* is non-nil, appends it to the file at that path." (apply #'format (cons t format-args)) (when *pushgp-output-path* (with-open-file (out *pushgp-output-path* :direction :output :if-exists :append :if-does-not-exist :create) (apply #'format (cons out format-args))))) (defun report (generation) "Reports on the specified generation of a pushgp run. Returns the best individual of the generation." (pushgp-output "~%~%;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;") (pushgp-output "~%;; -*- Report at generation ~A" generation) (let* ((sorted (sort *population* #'< :key #'individual-total-error)) (best (aref sorted 0))) (pushgp-output "~%Best individual:~%~A" (individual-program best)) (pushgp-output "~%Errors for best individual: ~A" (individual-errors best)) (pushgp-output "~%Total errors for best individual: ~A" (individual-total-error best)) (chart-out "bestfit" (individual-total-error best)) (pushgp-output "~%Size of best individual (points): ~A" (count-points (individual-program best))) (pushgp-output "~%~%Average total errors in population: ~A" (float (/ (reduce #'+ sorted :key #'individual-total-error) *population-size*))) (pushgp-output "~%Median total errors in population: ~A" (individual-total-error (aref sorted (truncate (length sorted) 2)))) (pushgp-output "~%Average program size in population (points): ~A" (float (/ (reduce #'+ sorted :key #'(lambda (g) (count-points (individual-program g)))) *population-size*))) (pushgp-output "~%Number of ERC variables: ~A" (length (apropos-list "ERC-VAR-"))) (pushgp-output "~%Number of RAND-generated variables: ~A" (length (apropos-list "PUSH-VAR-"))) (problem-specific-report) (pushgp-output "~%;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;~%") best)) (defun problem-specific-report () "This can be re-defined to report problem-specific information." nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pushgp top level (defun pushgp () "The top-level routine of pushgp." (init-population) (let ((success nil)) (do ((generation 0 (+ 1 generation))) ((or success (>= generation *max-generations*)) (cond (success (pushgp-output "~%SUCCESS at generation ~A~%" (- generation 1))) (t (pushgp-output "~%FAILURE~%")))) ;; compute fitnesses (pushgp-output "~%Evaluating fitness of population...") (dotimes (i *population-size*) (let* ((individual (aref *population* i)) (program (individual-program individual))) (when (eq (individual-errors individual) :unevaluated) (setf (individual-errors individual) (fitness program)) (setf (individual-total-error individual) (reduce #'+ (individual-errors individual)))))) ;; report and check for success (when (<= (individual-total-error (report generation)) *halting-fitness*) (setq success t)) ;; process migrants (process-migrants) ;; produce next generation (unless success (pushgp-output "~%Producing next generation...") (let ((child-population (make-array *population-size*))) (dotimes (i *population-size*) (setf (aref child-population i) (let ((n (randfloat 1.0))) (cond ((< n *mutation-probability*) (mutant)) ((< n (+ *mutation-probability* *crossover-probability*)) (hybrid)) ((< n (+ *mutation-probability* *crossover-probability* *Immigration-Probability*)) (immigrant)) (t (clone)))))) (setq *population* child-population)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; examples ;; Evaluate the code for a specific example and then (pushgp) to ;; run PushGP on the example problem. One way to do this is to ;; un-comment the problem specific code and the call to (pushgp) at ;; the bottom before compiling/loading this file. In the distributed ;; version of this file the first example is uncommented but the ;; call to (pushgp) is commented out. So with the distributed version ;; you can run the first example by compiling/loading this file (after ;; compiling/loading random.cl and push.lisp) and then evaluating (pushgp). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTEGER SYMBOLIC REGRESSION OF y = 5x^2+x-2 (defparameter *fitness-cases* ;; of form (x y) ;; y = 5x^2+x-2 (make-array *number-of-fitness-cases* :initial-contents (let ((cases nil)) (dotimes (x *number-of-fitness-cases*) (push (list x (- (+ (* 5 x x) x) 2)) cases)) (reverse cases)))) ;; integer -> integer (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*)) (huge-num 1E7)) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i)) (crashed nil)) (setq crashed (not (ignore-errors (progn (runpush program (list 'integer (first case))) t)))) (setf (aref errors i) (let ((int-stack (pushtype-stack (find-pushtype 'integer)))) (if (or crashed (null int-stack) (> *evalpush-count* *evalpush-limit*)) huge-num (abs (- (first int-stack) (second case)))))))) errors)) ;; (fitness '(integer dup dup 5 * * + 2 -)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTEGER SYMBOLIC REGRESSION OF FACTORIAL ;; Note: This is hard! At least it's hard to evolve a truly general ;; solution. If you get a general solution please let me know! #| (defun factorial (n) (if (< n 2) 1 (* n (factorial (- n 1))))) (defparameter *fitness-cases* ;; of form (x y) ;; y = x! (make-array *number-of-fitness-cases* :initial-contents (let ((cases nil)) (dotimes (x *number-of-fitness-cases*) (push (list x (factorial x)) cases)) (reverse cases)))) ;; integer -> integer (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*)) (huge-num 1E20)) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i)) (crashed nil)) (setq crashed (not (ignore-errors (progn (runpush program (list 'integer (first case))) t)))) (setf (aref errors i) (let ((int-stack (pushtype-stack (find-pushtype 'integer)))) (if (or crashed (null int-stack) (> *evalpush-count* *evalpush-limit*)) huge-num (normalize (abs (- (first int-stack) (second case))))))))) errors)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ODD PROBLEM #| (defparameter *fitness-cases* ;; odd problem ;; cases of form (int answer) (make-array *number-of-fitness-cases* :initial-contents (let ((cases nil)) (dotimes (i *number-of-fitness-cases*) (push (list i (oddp i)) cases)) (reverse cases)))) ;; integer->boolean (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*)) (huge-num 1E7)) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (runpush program (list 'integer (first case))) (setf (aref errors i) (let ((bool-stack (pushtype-stack (find-pushtype 'boolean)))) (if (or (null bool-stack) (> *evalpush-count* *evalpush-limit*)) huge-num (if (eq (first bool-stack) (second case)) 0 1)))))) errors)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EVEN-PARITY PROBLEMS ;; utility to produce fitness cases #| (defun parity-cases (n) "Returns a list of all of the even parity fitness cases of size n." (let ((inputs nil)) (dotimes (i (expt 2 n)) (push (mapcar #'(lambda (list) (subst t #\1 (subst nil #\0 list))) (coerce (format nil (concatenate 'string "~" (princ-to-string n) ",'0b") i) 'list)) inputs)) (mapcar #'(lambda (input) (list input (evenp (count t input)))) inputs))) |# ;; for all parity problems use the following fitness function ;; multiple booleans->boolean #|(defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*)) (huge-num 1E7)) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (apply #'runpush (cons program (mapcar #'(lambda (b) (list 'boolean b)) (first case)))) (setf (aref errors i) (let ((bool-stack (pushtype-stack (find-pushtype 'boolean)))) (if (or (null bool-stack) (> *evalpush-count* *evalpush-limit*)) huge-num (if (eq (first bool-stack) (second case)) 0 1)))))) errors)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EVEN-3-PARITY #| (defparameter *fitness-cases* ;; even-3-parity problem ;; cases of form (inputs output) (let ((cases-list (parity-cases 3))) (setq *number-of-fitness-cases* (length cases-list)) (make-array *number-of-fitness-cases* :initial-contents cases-list))) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EVEN-4-PARITY #| (defparameter *fitness-cases* ;; even-4-parity problem ;; cases of form (inputs output) (let ((cases-list (parity-cases 4))) (setq *number-of-fitness-cases* (length cases-list)) (make-array *number-of-fitness-cases* :initial-contents cases-list))) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EVEN-5-PARITY #| (defparameter *fitness-cases* ;; even-5-parity problem ;; cases of form (inputs output) (let ((cases-list (parity-cases 5))) (setq *number-of-fitness-cases* (length cases-list)) (make-array *number-of-fitness-cases* :initial-contents cases-list))) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; even n-parity (1-5) #| (defparameter *fitness-cases* ;; even-n-parity problem ;; cases of form (inputs output) (let ((cases-list (append (parity-cases 1) (parity-cases 2) (parity-cases 3) (parity-cases 4) (parity-cases 5)))) (setq *number-of-fitness-cases* (length cases-list)) (make-array *number-of-fitness-cases* :initial-contents cases-list))) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; run it (pushgp)