forked from jsvazic/GAHelloWorld
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge remote branch 'aerique/master'
- Loading branch information
Showing
3 changed files
with
426 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,67 @@ | ||
# Genetic Algorithm Hello World! (Common Lisp Edition) | ||
|
||
This is a simple project intended to showcase genetic algorithms with a well | ||
known example for all new developers; namely the classic "Hello, World!" | ||
example, written in Common Lisp. | ||
|
||
## Overview | ||
|
||
The application simply "evolves" the string "Hello, world!" from a population | ||
of random strings. It is intended to be a gentle introduction into the world | ||
of genetic algorithms, specifically using Common Lisp. The program itself is | ||
really simple, and is contained within a single file. | ||
|
||
The source is a pretty direct translation of the Python version using | ||
Common Lisp idiom, barring some parts that weren't understood. It has | ||
not been optimized for speed. | ||
|
||
You'll notice some repetition of TARGET and "Hello, World!", this is | ||
my personal preference for (and verbose combination of) default values | ||
and being explicit when calling functions. It also helps for testing | ||
on the REPL. | ||
|
||
## Usage | ||
|
||
The project is completely self contained. To execute the application, run | ||
the following command from a shell (assuming `clisp`, `ecl` or `sbcl` | ||
is on your system path): | ||
|
||
- CCL: my old 1.4 version fails, don't know why | ||
- CLISP: `clisp -i ga-hello-world.lisp -x "(progn (main) (quit))"` | ||
- ECL: `ecl -l ga-hello-world.lisp -eval "(progn (main) (quit))"` | ||
- SBCL: `sbcl --load ga-hello-world.lisp --eval "(progn (main) (quit))"` | ||
|
||
The more 'Lispy' way would be just starting you CL implementation and | ||
issuing `(load "ga-hello-world.lisp")` and then calling the MAIN | ||
function. | ||
|
||
To run the tests you need the `lisp-unit` package. To run them from | ||
the commandline issue: | ||
|
||
- CLISP: `clisp -i ga-hello-world-tests.lisp` | ||
- ECL: `ecl -l ga-hello-world-tests.lisp` | ||
- SBCL: `sbcl --load ga-hello-world-tests.lisp` | ||
|
||
## Copyright and License | ||
|
||
The MIT License | ||
|
||
Copyright © 2011 John Svazic, Erik Winkels | ||
|
||
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. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,149 @@ | ||
;;;; The MIT License | ||
;;;; | ||
;;;; Copyright (c) 2011 John Svazic, Erik Winkels | ||
;;;; | ||
;;;; 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. | ||
|
||
;;;; author: Erik Winkels <aerique@xs4all.nl> | ||
;;;; | ||
;;;; See README.md for documentation. | ||
|
||
(asdf:oos 'asdf:load-op :lisp-unit) | ||
(use-package :lisp-unit) | ||
|
||
(load "ga-hello-world.lisp") | ||
|
||
|
||
;;; Specials | ||
|
||
(defvar *target* "Hello, world!") | ||
|
||
|
||
;;; Tests | ||
|
||
(define-test fitness | ||
(let ((c1 (make-chromosome *target* *target*)) | ||
(c2 (make-chromosome *target* "H5p&J;!l<X\\7l")) | ||
(c3 (make-chromosome *target* "Vc;fx#QRP8V\\$")) | ||
(c4 (make-chromosome *target* "t\\O`E_Jx$n=NF"))) | ||
(assert-equal 0 (fitness c1)) | ||
(assert-equal 399 (fitness c2)) | ||
(assert-equal 297 (fitness c3)) | ||
(assert-equal 415 (fitness c4)))) | ||
|
||
|
||
(define-test random-gene | ||
(loop repeat 1000 | ||
for c = (make-chromosome *target*) | ||
do (assert-true (>= (fitness c) 0)) | ||
(assert-equal 13 (length (gene c))) | ||
(loop for ch across (gene c) ; immons | ||
do (assert-true (>= (char-code ch) 32)) | ||
(assert-true (<= (char-code ch) 122))))) | ||
|
||
|
||
(define-test mutate | ||
(loop repeat 1000 | ||
for c1 = (make-chromosome *target*) | ||
for c2 = (mutate c1) | ||
do (assert-equal (length (gene c1)) (length (gene c2))))) | ||
; skipping from Python tests, since I don't know what they do: | ||
; | ||
; s1 = set(c1.gene) | ||
; s2 = set(c2.gene) | ||
; self.assertTrue(len(s1 - s2) <= 1) | ||
|
||
|
||
(define-test mate | ||
(let* ((c1 (make-chromosome *target*)) | ||
(c2 (make-chromosome *target*)) | ||
(children (mate c1 c2))) | ||
(assert-equal 2 (length children)) | ||
(assert-equal 13 (length (gene (elt children 0)))) | ||
(assert-equal 13 (length (gene (elt children 1)))))) | ||
; needs test to check the genes | ||
|
||
|
||
(define-test crossover | ||
(let ((p1 (make-population :crossover 0.8)) | ||
(p2 (make-population :crossover 0.0)) | ||
(p3 (make-population :crossover 1.0))) | ||
(assert-equal 0.8 (crossover p1)) | ||
(assert-equal 0.0 (crossover p2)) | ||
(assert-equal 1.0 (crossover p3)))) | ||
|
||
|
||
(define-test elitism | ||
(let ((p1 (make-population :elitism 0.1)) | ||
(p2 (make-population :elitism 0.0)) | ||
(p3 (make-population :elitism 0.99))) | ||
(assert-equal 0.1 (elitism p1)) | ||
(assert-equal 0.0 (elitism p2)) | ||
(assert-equal 0.99 (elitism p3)))) | ||
|
||
|
||
(define-test mutation | ||
(let ((p1 (make-population :mutation 0.05)) | ||
(p2 (make-population :mutation 0.0)) | ||
(p3 (make-population :mutation 1.0))) | ||
(assert-equal 0.05 (mutation p1)) | ||
(assert-equal 0.0 (mutation p2)) | ||
(assert-equal 1.0 (mutation p3)))) | ||
|
||
|
||
(define-test population | ||
(let* ((predicate (lambda (a b) (< (fitness a) (fitness b)))) | ||
(p1 (make-population :size 1024)) | ||
(p1c (copy-seq (chromosomes p1))) | ||
(p2 (make-population :size 2048)) | ||
(p2c (copy-seq (chromosomes p2)))) | ||
(assert-equal 1024 (size p1)) | ||
(assert-equal 1024 (length (chromosomes p1))) | ||
(assert-equal (chromosomes p1) (sort p1c predicate)) | ||
(assert-equal 2048 (size p2)) | ||
(assert-equal 2048 (length (chromosomes p2))) | ||
(assert-equal (chromosomes p2) (sort p2c predicate)))) | ||
|
||
|
||
(define-test evolve | ||
(let* ((p (make-population :size 1024 :crossover 0.8 :elitism 0.1 | ||
:mutation 0.05)) | ||
(pc (copy-seq (chromosomes p)))) | ||
(evolve p) | ||
(assert-equal 0.8 (crossover p)) | ||
(assert-equal 0.1 (elitism p)) | ||
(assert-equal 0.05 (mutation p)) | ||
(let ((elitism-count (floor (* 1024 0.1))) | ||
(counter 0)) | ||
(loop for c in pc | ||
do (when (member c (chromosomes p)) | ||
(incf counter))) | ||
(assert-true (>= counter elitism-count)) | ||
(assert-true (< counter (length pc)))))) | ||
|
||
|
||
;;; Run the tests. | ||
|
||
(format t "--- running tests ---~%") | ||
(run-tests) | ||
(format t "~&") | ||
(quit) |
Oops, something went wrong.