(defun initialPop ()
(let ((population '())
(poplist '())
(a (make-list 0))
)
(dotimes (x 100)
(setf poplist (make-list 1 :initial-element (random 2)))
(dotimes (n 9)
(setf a (make-list 1 :initial-element (random 2)))
(setf poplist (append poplist a))
)
(push poplist population)
)
population
)
)
(defun main (&optional (count 0) (population (initialPop)))
(let ((populationsorted '())
(toptwentypop '())
(mutatedpop80 '()))
(setf populationsorted (scorepop population))
(if (equal '(1 0 1 0 1 0 1 0 1 0) (nth 0 populationsorted))
(progn
(format t "Minimum found. Iterations: ~D~%Current sorted population: ~S~%" count populationsorted)
)
(progn
(setf toptwentypop (topTwenty populationsorted))
(setf mutatedpop80 (rearrange populationsorted))
(setf population (append mutatedpop80 toptwentypop))
(setf count (+ count 1))
(main count population)
)
)
)
)
(defun scorepop (population)
(let ((score '())
(scoredpop '())
(populationsortedraw)
(populationsorted))
(dotimes (x 100)
(setf score 0)
(dotimes (n 9)
(if (eq 0 (rem n 2))
(progn
(if (eq 1 (nth n (nth x population)))
(setf score (+ score 1))
)
)
(progn
(if (eq 0 (nth n (nth x population)))
(setf score (+ score 1))
)
)
)
)
(setf score (make-list 1 :initial-element score))
(push (list (nth 0 score) (nth x population)) scoredpop)
)
(setf populationsortedraw (sort scoredpop #'> :key #'car))
(dotimes (x 100)
(push (nth 1 (nth x populationsortedraw)) populationsorted)
)
(reverse populationsorted)
)
)
(defun topTwenty (populationsorted)
(let (toptwentypop '())
(dotimes (x 20)
(let ((scoredpop (nth x populationsorted)))
(push scoredpop toptwentypop))
)
(setf toptwentypop (reverse toptwentypop))
)
)
(defun rearrange (populationsorted)
(let ((tobemutated1 '())
(tobemutated2 '())
(mutatedpop1 '())
(mutatedpop2 '())
(mutatedpop80 '())
(cutsite '()))
(dotimes (x 40)
(setf tobemutated1 (nth (random 100) populationsorted))
(setf tobemutated2 (nth (random 100) populationsorted))
(setf cutsite (random (length tobemutated1)))
(setf mutatedpop1 (append (subseq tobemutated1 0 cutsite) (subseq tobemutated2 cutsite (length tobemutated1))))
(setf mutatedpop2 (append (subseq tobemutated2 0 cutsite) (subseq tobemutated1 cutsite (length tobemutated2))))
(push mutatedpop1 mutatedpop80)
(push mutatedpop2 mutatedpop80)
)
mutatedpop80
)
)
(main)