Skip to content

Instantly share code, notes, and snippets.

@corehello
Created February 26, 2015 08:45
Show Gist options
  • Save corehello/e501340a0d5df12ab26a to your computer and use it in GitHub Desktop.
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
(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