Initial data commit

Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-1.lisp

@@ -0,0 +1,39 @@
+(defun fitness (string target)
+  "Closeness of string to target; lower number is better"
+  (loop for c1 across string
+        for c2 across target
+        count (char/= c1 c2)))
+
+(defun mutate (string chars p)
+  "Mutate each character of string with probablity p using characters from chars"
+  (dotimes (n (length string))
+    (when (< (random 1.0) p)
+      (setf (aref string n) (aref chars (random (length chars))))))
+  string)
+
+(defun random-string (chars length)
+  "Generate a new random string consisting of letters from char and specified length"
+  (do ((n 0 (1+ n))
+       (str (make-string length)))
+      ((= n length) str)
+    (setf (aref str n) (aref chars (random (length chars))))))
+
+(defun evolve-string (target string chars c p)
+  "Generate new mutant strings, and choose the most fit string"
+  (let ((mutated-strs (list string)))
+    (dotimes (n c)
+      (push (mutate (copy-seq string) chars p) mutated-strs))
+    (reduce #'(lambda (s0 s1)
+                (if (< (fitness s0 target)
+                       (fitness s1 target))
+                    s0
+                    s1))
+            mutated-strs)))
+
+(defun evolve-gens (target c p)
+  (let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+    (do ((parent (random-string chars (length target))
+                 (evolve-string target parent chars c p))
+         (n 0 (1+ n)))
+        ((string= target parent) (format t "Generation ~A: ~S~%" n parent))
+      (format t "Generation ~A: ~S~%" n parent))))

Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-2.lisp

@@ -0,0 +1,23 @@
+(defun unfit (s1 s2)
+  (loop for a across s1
+	for b across s2 count(char/= a b)))
+
+(defun mutate (str alp n) ; n: number of chars to mutate
+  (let ((out (copy-seq str)))
+    (dotimes (i n) (setf (char out (random (length str)))
+			 (char alp (random (length alp)))))
+    out))
+
+(defun evolve (changes alpha target)
+  (loop for gen from 1
+	with f2 with s2
+	with str = (mutate target alpha 100)
+	with fit = (unfit target str)
+	while (plusp fit) do
+	(setf s2 (mutate str alpha changes)
+	      f2 (unfit target s2))
+	(when (> fit f2)
+	  (setf str s2 fit f2)
+	  (format t "~5d: ~a (~d)~%" gen str fit))))
+
+(evolve 1 " ABCDEFGHIJKLMNOPQRSTUVWXYZ" "METHINKS IT IS LIKE A WEASEL")

Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-3.lisp

@@ -0,0 +1,27 @@
+   44: DYZTOREXDML ZCEUCSHRVHBEPGJE (26)
+   57: DYZTOREXDIL ZCEUCSHRVHBEPGJE (25)
+   83: DYZTOREX IL ZCEUCSHRVHBEPGJE (24)
+   95: MYZTOREX IL ZCEUCSHRVHBEPGJE (23)
+  186: MYZTOREX IL ZCEUISHRVHBEPGJE (22)
+  208: MYZTOREX IL ZCEUISH VHBEPGJE (21)
+  228: MYZTOREX IL ZCEUISH VHBEPGEE (20)
+  329: MYZTOREX IL ZCEUIKH VHBEPGEE (19)
+  330: MYTTOREX IL ZCEUIKH VHBEPGEE (18)
+  354: MYTHOREX IL ZCEUIKH VHBEPGEE (17)
+  365: MYTHOREX IL ICEUIKH VHBEPGEE (16)
+  380: MYTHOREX IL ISEUIKH VHBEPGEE (15)
+  393: METHOREX IL ISEUIKH VHBEPGEE (14)
+  407: METHORKX IL ISEUIKH VHBEPGEE (13)
+  443: METHORKX IL ISEUIKH VHBEPSEE (12)
+  455: METHORKX IL ISEUIKE VHBEPSEE (11)
+  477: METHIRKX IL ISEUIKE VHBEPSEE (10)
+  526: METHIRKS IL ISEUIKE VHBEPSEE (9)
+  673: METHIRKS IL ISEUIKE VHBEPSEL (8)
+  800: METHINKS IL ISEUIKE VHBEPSEL (7)
+  875: METHINKS IL ISEUIKE AHBEPSEL (6)
+  941: METHINKS IL ISEUIKE AHBEASEL (5)
+ 1175: METHINKS IT ISEUIKE AHBEASEL (4)
+ 1214: METHINKS IT ISELIKE AHBEASEL (3)
+ 1220: METHINKS IT IS LIKE AHBEASEL (2)
+ 1358: METHINKS IT IS LIKE AHWEASEL (1)
+ 2610: METHINKS IT IS LIKE A WEASEL (0)