@@ -1,5 +1,38 @@ README.TXT + + *** Introduction *** + +Genesis is a Lisp genetic programming library currently in the +prototype stage. You can currently use the (genetic-algorithm) call in +order to run a genetic algorithm. A sample call is as follows: + + (genetic-algorithm 1000 nil #'sample-rule-fun + #'sample-fitness-function + :population-size 5) + + +The prototype for the function is as follows: + + (genetic-algorithm (generations starting-rules rule-fun + fitness-fun &key (population-size 10)) + + +If you would only like to see an example of this in action, load the +file "square-root-sample.lisp" and run the function +(square-root-sample generations population-size). + +To call the function in your population with the best results so far, +use the (funcall-best) function: + +> (funcall-best genesis:*CURRENT-POPULATION* #'sample-fitness-fun 16) + 4.abillion + + + +A homepage with a tutorial is going to be set up soon at jakevoytko.com! + + Copyright (c) 2008 Jake Voytko Permission is hereby granted, free of charge, to any person obtaining @@ -21,18 +54,3 @@ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - - *** Introduction *** - -Genesis is a Lisp genetic programming library currently in the -prototype stage. You can currently use the (genetic-algorithm) call in -order to run a genetic algorithm. A sample call is as follows: - - (genetic-algorithm 32000 init-rules #'sample-rule-fun - #'sample-fitness-function) - -You can compile init-rules as follows: - - (setf init-rules (list (new-rule #'sample-rule-fun))) - -A homepage with a tutorial is going to be set up soon at jakevoytko.com! README.txt @@ -143,11 +143,6 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. (dolist (fn rules) (setf val (funcall (rule-fun fn) val))) val)) - - -(defun evaluate-rules (rules fitness-fun) - "Evaluates 'rules' using 'fitness-fun'." - (funcall fitness-fun rules)) (defun remove-item-from-list (list index) @@ -174,7 +169,8 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. (defmacro mutate-rule-list (rule-fun rules) - "Modifies a list of rules by randomly adding and replacing rules." + "Destructively modifies a list of rules by randomly adding and +replacing rules." `(progn (when (coin-flip) (setf ,rules (remove-random-item ,rules))) (when (coin-flip) (setf ,rules (add-to-rule-list ,rule-fun ,rules))) @@ -186,21 +182,74 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. "Randomly merges elements of the lists rule1 and rule2 together." (if (eql rule1 rule2) rule1 - (setf rule1 (merge 'list rule1 rule2 (lambda (a b) (coin-flip)))))) + (merge 'list rule1 rule2 (lambda (a b) (coin-flip))))) + + +(defmacro swap (item1 item2) + "Swaps the contents of item1 and item2. I can't believe this isn't defined + in the standard." + (let ((tmp (gensym))) + `(progn + (setf ,tmp ,item1) + (setf ,item1 ,item2) + (setf ,item2 ,tmp)))) + + +(defun random-subsequence (list) + (let ((start (random (length list))) + (end (random (length list)))) + (when (< end start) + (swap start end)) + (if (= start end) + (random-subsequence list) + (subseq list start (+ 1 end))))) + + +(defun splice (list1 list2 start end) + "Replaces the elements of 'list1' in indices [start,end) with the contents + of list2" + (if (>= start (length list1)) + (append list1 list2) + (labels ((insert-subseq (l1 l2 begin end curr) + (cond ((= curr begin) + (append l2 (subseq l1 end (- (length l1) 1 end)))) + ((< curr begin) + (cons (car l1) ; Current element ++ spliced subsequence + (insert-subseq (cdr l1) + l2 begin end (+ curr 1)))) + ((null list1) list2)))) + (insert-subseq list1 list2 start end 0)))) + + +(defun random-breed (rule1 rule2) + "Creates a new rule who has rule1 and rule2 as a parent by inserting + subsequences of rule2 into rule1. Extra insertions decided by coin-flip." + (let* ((new-dna (random-subsequence rule2)) + (start-pos (random (length rule1))) + (end-pos (random (- (length rule1) 1 start-pos)))) + (splice rule1 new-dna start-pos end-pos))) + + +(defmacro breed-rules (rule1 rule2) + "Destructively breed genes from rule2 into rule1." + `(when (not (or (null ,rule1) (null ,rule2))) + (setf ,rule1 + (if (coin-flip) + (random-merge-rules ,rule1 ,rule2))))) +; (random-breed ,rule1 ,rule2))))) (defun run-generation (rule-fun fitness-fun) - "Runs a single generation, assigning *RULES* to be the most successful - run to date" + "Runs a single generation, and update critters in place instead of keeping + the n best." (dotimes (rulenum (length *CURRENT-POPULATION*)) (let* ((cur-rule (aref *CURRENT-POPULATION* rulenum)) (rules-score (funcall fitness-fun cur-rule)) (rule-variation (copy-list cur-rule))) (if (coin-flip) (mutate-rule-list rule-fun rule-variation) - (random-merge-rules rule-variation - (copy-list (random-array-element - *CURRENT-POPULATION*)))) + (breed-rules rule-variation + (copy-list (random-array-element *CURRENT-POPULATION*)))) (when (> (length rule-variation) *MAX-RULE-SIZE*) (setf rule-variation (subseq rule-variation 0 *MAX-RULE-SIZE*))) (when (<= (funcall fitness-fun rule-variation) genesis.lisp @@ -1,21 +1,25 @@ * Algorithmic -** DONE Multiple rule sets in a population - <2008-12-11 Thu 00:17> - - Because one is just hill climbing. This opens the door to true - evolution (see other TODO items) - ** TODO Multiple populations. -** TODO Cross-breeding between rule sets. ** TODO Cross-breeding between populations. -** DONE Removing rules at random - <2008-12-12 Fri 00:17> - ** TODO Maximum rules/list, maximum lists/population, maximum populations [1/3] - [X] Maximum rule lists - [ ] Maximum populations - [ ] Maximum rules ** TODO Notice when rules flatline, try more drastic changes? +** TODO Keep track of which type of rule alterations are more successful? +** DONE Removing rules at random + <2008-12-12 Fri 00:17> + +** DONE Multiple rule sets in a population + <2008-12-11 Thu 00:17> + + Because one is just hill climbing. This opens the door to true + evolution (see other TODO items) + +** DONE [2/2] Cross-breeding between rule sets. + - [X] Random merge + - [X] Replacement of random subsequences + <2008-12-18 Thu 22:54> * Performance ** TODO Multithreading @@ -24,11 +28,39 @@ ** TODO Notice f(x)=x rules? ** DONE Start tests for all standard functions. ** TODO Add tests for all standard functions. -** TODO Make a package. +** DONE Make a package. + <2008-12-13 Sat 12:05> ** TODO Split project into proper files. ** TODO Form into an asdf-install package. ** TODO Figure out where I'm documenting this piece. * Interface ** TODO Give key arguments to give (genetic-algorithm) much more control. -** TODO (funcall-best population) +** DONE (funcall-best population) + <2008-12-13 Sat 12:05> + + + + + + + Copyright (c) 2008 Jake Voytko + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. todo.org b2cc9e9bd1238a4570f7820e3dd98bdc5b1f5441 Jake Voytko jakevoytko@gmail.com http://github.com/jakevoytko/genesis/commit/bd7e41215e5aa40f2658744b6f0a952df4ceae6d bd7e41215e5aa40f2658744b6f0a952df4ceae6d 2008-12-18T20:04:03-08:00 2008-12-18T20:04:03-08:00 Added the capability to splice random genes from one rule list to another via GENESIS::SPLICE. This is the closest thing to meiosis that I have achieved. This appears to have improved the convergence of the algorithm considerably, but the GC appears to run more frequently. README.txt is a little more substantial at this point. I'm going to have a lot of time over Christmas, so I will use this time to catch up on writing tests and packaging this project properly with ASDF (and maybe Mudball...). 7f9a93acd62dbd32949ce86de36c4dd87924c420 Jake Voytko jakevoytko@gmail.com