;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pushgp.lisp ;; a genetic programming system that evolves programs in the push ;; programming language ;; c) 2000-2003, Lee Spector (lspector@hampshire.edu) ;; ;; distribution location: http://hampshire.edu/lspector/push.html ;; for version information see revision history below #| PushGP is a genetic programming system that evolves Push programs. Although it is a simple system in many respects, it has the following attractive features: - Multiple data types without constraints on code generation or manipulation. - Arbitrary modularity without constraints on code generation or manipulation. - Evolved module architecture with no extra machinery. - Support for explicit, arbitrary recursion. - Support for ontogenetic development and, via extensions such as Pushpop, diversifying self-replication. The Push programming language for evolutionary computation is documented in several publications listed at: http://hampshire.edu/lspector/push.html This version of PushGP was developed for use with version 2 of the Push language specification (a.k.a. Push2), which is documented at: http://hampshire.edu/lspector/push2-description.html This code is written in Common Lisp. It has been tested in Macintosh Common Lisp, OpenMCL, 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 code is being made available for non-commercial educational and research uses only. To Use ------ PushGP requires a Common Lisp programming environment. If you need one then you might start by looking at: http://www.lisp.org/table/systems.htm A "load" file is included that will compile and run the system on an example symbolic regression problem. One way to use this is to start the Lisp interpreter and then type the following to the Lisp prompt: (load "load") In some Lisps running under Unix/Linux/etc. you can do everything directly from the shell by typing the following to the shell prompt while in the pushgp directory: lisp -load load This assumes that your Lisp executable is called "lisp" -- substitute as appropriate. You'll want to quit Lisp after your run. If it's not obvious how to do this then try typing (quit) or (exit) to the Lisp prompt. To change parameters of the run (including the problem, fitness function, etc.) read the comment at the top of pushgp.lisp. Additional documentation is in the comment at the top of push.lisp. Miscellaneous Notes ------------------- There are many parameters that can be changed; see the "pushgp globals and parameters" section in the code below. Parameters for the Push interpreter itself are generally set in the push configuration file. 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 definitions for *FITNESS-CASES* and FITNESS for another example. c) Reload/run. 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) via the push configuration file (push.pconf). 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 and the GPEM journal article. For more details on turning types on/off see: http://hampshire.edu/lspector/push2-description.html Five kinds of mutation are implemented: sub-expression replacement, sub-expression addition, sub-expression removal, 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 edit "load" to set *CLUSTER* to T and to set paths to the local (per node) scratch directory and to the shared (cross-mounted) directory. The current cluster code 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. (Changes to the cluster naming scheme would be made here in pushgp.lisp, below.) 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) 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. 20030405 - Fixed bug making "perturb" mutation ineffectual. 20030413 - Minor change to cluster code to accomodate Hampshire's node-naming scheme for "hex". 20030831 - Commented out complete-push-configuration to allow for configuration from file with push2 20030918 - Removed push configuration parameters - Changed examples to conform to new runpush syntax 20030925 - Crashed-proofed fitness testing in PUSHGP, so it needn't be done in individual fitness functions. - Added *fitness-for-invalid-program*. 20031229 - Added regression example with input from a constant, rather than the stack. - Added ADD and REMOVE mutation methods. - Removed obsolete call to complete-push-configuration. - Removed problem-specific-initialization. - Switched random seeding to be based on the pushparameter *RANDOM-SEED*. - The effective seed will be the configured seed PLUS the host number (which is 1 if not running on a cluster). - Documentation revised for posting with Push2. 20031230 - Changed config file extension to .pconf (instead of .pst). |# ;; 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 "n01...", "n02...", 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 3)) 1)) ;; Increment random seed from *host-number* (setq *random-seed* (+ *random-seed* *host-number*)) ;; The *host-extension* will be appended output file names. (defparameter *host-extension* (if (string-equal *host* "") "" (concatenate 'string "." *host*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pushgp globals and parameters ;; parameters that should be set (defparameter *max-new-points-in-mutants* 20 "The maximum number of points that may be added by a single 'standard' mutation.") (defparameter *population-size* 1000 "The size of the genetic programming population.") (defparameter *tournament-size* 7 "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* 25 "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.475 "The probability that an individual in the next generation will be produced by mutation.") (defparameter *crossover-probability* 0.475 "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 'add 'remove ) "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 *fitness-for-invalid-program* 1E7 "This is the fitness per fitness case for any program that crashes during the evaluation of any fitness case. Also used in fitness functions as the fitness for a case in which *evalpush-limit* is exceeded or insufficient values are left on result stacks.") (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." (setq *push-names* nil) ;** push generated variables (random::seed-state *random-seed* *random-seed*) (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 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 remove-everywhere (item list) (if (listp list) (remove item (mapcar #'(lambda (i) (remove-everywhere item i)) list)) list)) (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))) (perturb (dirty-copy p *dirty-mutation-denominator*)) (add (let* ((pt (randint (count-points p))) (old-frag (code-at-point p pt)) (new-frag (random-code *max-new-points-in-mutants*)) (new-program (insert-code-at-point p pt (if (zerop (randint 2)) (list old-frag new-frag) (list new-frag old-frag))))) (if (> (count-points new-program) *Max-Points-In-Program*) p new-program))) (remove (let* ((pt (randint (count-points p))) (unique (gensym)) (new-program (remove-everywhere unique (insert-code-at-point p pt unique)))) new-program)) ))) (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) ;;** crash-proofed (let ((crashed nil)) (setq crashed (not (ignore-errors (setf (individual-errors individual) (fitness program)) (setf (individual-total-error individual) (keep-number-reasonable (reduce #'+ (individual-errors individual)))) t))) (when crashed (setf (individual-errors individual) (make-array *number-of-fitness-cases* :initial-element *fitness-for-invalid-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 ;; Note that the first example will run by default as this file is ;; distributed. To run others comment it out and un-comment the appropriate ;; section below. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTEGER SYMBOLIC REGRESSION OF y = 5x^2+x-2 ;; WITH INPUT PROVIDED VIA A CONSTANT INSTRUCTION (NOT THE STACK) ;; ;; for this to work you must add the following line to ;; the push2 config file: ;; ;; constant INTEGER INPUT (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)))) ;; constant -> integer (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*))) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) ;; here's where we set the constant (SETCONSTANT 'INPUT (first case)) (runpush program) (setf (aref errors i) (let ((int-stack (pushtype-stack (find-pushtype 'integer)))) (if (or (null int-stack) (> *evalpush-count* *evalpush-limit*)) *fitness-for-invalid-program* (abs (- (first int-stack) (second case)))))))) errors)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTEGER SYMBOLIC REGRESSION OF y = 5x^2+x-2 ;; WITH INPUT PROVIDED VIA THE STACK #| (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*))) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (runpush program (list (first case))) (setf (aref errors i) (let ((int-stack (pushtype-stack (find-pushtype 'integer)))) (if (or (null int-stack) (> *evalpush-count* *evalpush-limit*)) *fitness-for-invalid-program* (abs (- (first int-stack) (second case)))))))) errors)) |# ;; (fitness '(integer.dup integer.dup 5 integer.* integer.* integer.+ 2 integer.-)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INTEGER SYMBOLIC REGRESSION OF FACTORIAL ;; Note: This is hard! At least it's hard to evolve a truly general ;; solution. If you evolve a general solution please let me know! ;; Here is a hand-coded solution: ;; ( CODE.QUOTE ( INTEGER.POP 1 ) ;; CODE.QUOTE ( CODE.DUP INTEGER.DUP 1 INTEGER.- CODE.DO INTEGER.* ) ;; INTEGER.DUP 2 INTEGER.< CODE.IF ) #| (defun factorial (n) (if (< n 2) 1 (* n (factorial (- n 1))))) ;; override number of fitness cases here, so numbers don't get enormous (setq *number-of-fitness-cases* 8) (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*))) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (runpush program (list (first case))) (setf (aref errors i) (let ((int-stack (pushtype-stack (find-pushtype 'integer)))) (if (or (null int-stack) (> *evalpush-count* *evalpush-limit*)) *fitness-for-invalid-program* (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 (tnil->boolean (oddp i))) cases)) (reverse cases)))) ;; integer->boolean (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*))) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (runpush program (list (first case))) (setf (aref errors i) (let ((bool-stack (pushtype-stack (find-pushtype 'boolean)))) (if (or (null bool-stack) (> *evalpush-count* *evalpush-limit*)) *fitness-for-invalid-program* (if (eq (first bool-stack) (second case)) 0 1)))))) errors)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EVEN-PARITY PROBLEMS ;; ;; The parity cases are generated algorithmically, so it's easy to switch ;; the "size" of the problem, or to base fitness on performance over many ;; different sizes. See the comment in *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 'TRUE #\1 (subst 'FALSE #\0 list))) (coerce (format nil (concatenate 'string "~" (princ-to-string n) ",'0b") i) 'list)) inputs)) (mapcar #'(lambda (input) (list input (tnil->boolean (evenp (count 'TRUE input))))) inputs))) (defparameter *fitness-cases* ;; even-n-parity problem ;; cases of form (inputs output) (let ((cases-list (append ;; Comment different sizes out/in here and/or ;; change the numbers ;(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))) ;; multiple booleans->boolean (defun fitness (program) (let ((errors (make-array *number-of-fitness-cases*))) (dotimes (i *number-of-fitness-cases*) (let ((case (aref *fitness-cases* i))) (runpush program (first case)) (setf (aref errors i) (let ((bool-stack (pushtype-stack (find-pushtype 'boolean)))) (if (or (null bool-stack) (> *evalpush-count* *evalpush-limit*)) *fitness-for-invalid-program* (if (eq (first bool-stack) (second case)) 0 1)))))) errors)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; run it (by default we don't -- it's done from the loader) ;(pushgp)