Created
February 26, 2015 08:45
-
-
Save corehello/e501340a0d5df12ab26a to your computer and use it in GitHub Desktop.
Generic algorithm in common lisp from http://www.cs.colostate.edu/~anderson/cs540/labs/galisp.html
This file contains hidden or 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
(defun reproduce (population) | |
(let ((offspring nil) | |
(d (distribution population))) | |
(dotimes (i (/ (length population) 2)) | |
(let ((x (selectone d)) | |
(y (selectone d))) | |
(crossover x y) | |
(setq offspring (nconc (list x y) offspring)))) | |
offspring)) | |
(defun distribution (population) | |
(let* ((genotypes (remove-duplicates population :test #'equal)) | |
(sum (apply #'+ (mapcar #'fitness genotypes)))) | |
(mapcar #'(lambda (x) (cons (/ (fitness x) sum) x)) genotypes))) | |
(defun selectone (distribution) | |
(let ((random (random 1.0)) | |
(prob 0) | |
genotype) | |
(some #'(lambda (pair) | |
(incf prob (first pair)) | |
(if (> random prob) nil | |
;;else | |
(setq genotype (rest pair)))) | |
distribution) | |
(mutate genotype))) | |
(defun crossover (x y) | |
(if (> (random 1.0) 0.6) (list x y) | |
;;else | |
(let* ((site (random (length x))) | |
(swap (rest (nthcdr site x)))) | |
(setf (rest (nthcdr site x)) (rest (nthcdr site y))) | |
(setf (rest (nthcdr site y)) swap)))) | |
(defun mutate (genotype) | |
(mapcar #'(lambda (x) | |
(if (> (random 1.0) 0.03) x | |
;; else | |
(if (= x 1) 0 | |
;; else | |
1))) | |
genotype)) | |
(defun fitness (x) | |
(let ((xarg (/ (string2num x) 1073741823.0)) | |
(v '(0.5 0.25 1.0 0.25)) | |
(c '(0.125 0.375 0.625 0.875)) | |
(w 0.003)) | |
(reduce #'+ (mapcar #'(lambda (vi ci) | |
(let ((xc (- xarg ci))) | |
(* vi (exp (* -1 (/ (* 2 w)) xc xc))))) | |
v c)))) | |
(defun string2num (s) | |
(loop for xi in (reverse s) for p = 1 then (* p 2) sum (* xi p))) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment