Guest

Untitled

By: a guest on Jan 19th, 2012  |  syntax: Lisp  |  size: 2.69 KB  |  hits: 56  |  expires: Never
download  |  raw  |  embed  |  report abuse
Copied
  1. (defun initialPop ()
  2.         (let ((population '())
  3.         (poplist '())
  4.         (a (make-list 0))
  5.                 )
  6.                 (dotimes (x 100)
  7.                   (setf poplist (make-list 1 :initial-element (random 2)))
  8.                   (dotimes (n 9)
  9.                         (setf a (make-list 1 :initial-element (random 2)))
  10.                         (setf poplist (append poplist a))
  11.                         )
  12.                   (push poplist population)
  13.                 )
  14.                 population
  15.         )
  16. )
  17.  
  18.  
  19.  
  20. (defun main (&optional (count 0) (population (initialPop)))
  21.         (let ((populationsorted '())
  22.         (toptwentypop '())
  23.         (mutatedpop80 '()))
  24.                 (setf populationsorted (scorepop population))
  25.                 (if (equal '(1 0 1 0 1 0 1 0 1 0) (nth 0 populationsorted))
  26.                         (progn
  27.                                 (format t "Minimum found. Iterations: ~D~%Current sorted population: ~S~%" count populationsorted)
  28.                         )
  29.                         (progn
  30.                                 (setf toptwentypop (topTwenty populationsorted))
  31.                                 (setf mutatedpop80 (rearrange populationsorted))
  32.                                 (setf population (append mutatedpop80 toptwentypop))
  33.                                 (setf count (+ count 1))
  34.                                 (main count population)
  35.                         )
  36.                 )
  37.         )
  38. )
  39.                                
  40. (defun scorepop (population)
  41.         (let ((score '())
  42.         (scoredpop '())
  43.         (populationsortedraw)
  44.         (populationsorted))
  45.                 (dotimes (x 100)
  46.                         (setf score 0)
  47.                         (dotimes (n 9)
  48.                                 (if (eq 0 (rem n 2))
  49.                                         (progn
  50.                                                 (if (eq 1 (nth n (nth x population)))
  51.                                                         (setf score (+ score 1))
  52.                                                 )
  53.                                         )
  54.                                         (progn
  55.                                                 (if (eq 0 (nth n (nth x population)))
  56.                                                         (setf score (+ score 1))
  57.                                                 )
  58.                                         )
  59.                                
  60.                                 )
  61.                  
  62.                         )
  63.                         (setf score (make-list 1 :initial-element score))
  64.                         (push (list (nth 0 score) (nth x population)) scoredpop)
  65.                 )
  66.                 (setf populationsortedraw (sort scoredpop #'> :key #'car))
  67.                 (dotimes (x 100)
  68.                   (push (nth 1 (nth x populationsortedraw)) populationsorted)
  69.                 )
  70.                 (reverse populationsorted)
  71.     )
  72. )
  73.  
  74. (defun topTwenty (populationsorted)
  75.         (let (toptwentypop '())
  76.                 (dotimes (x 20)
  77.                         (let ((scoredpop (nth x populationsorted)))
  78.                         (push scoredpop toptwentypop))
  79.                 )
  80.                 (setf toptwentypop (reverse toptwentypop))
  81.         )
  82. )
  83.  
  84. (defun rearrange (populationsorted)
  85.         (let ((tobemutated1 '())
  86.         (tobemutated2 '())
  87.         (mutatedpop1 '())
  88.         (mutatedpop2 '())
  89.         (mutatedpop80 '())
  90.         (cutsite '()))
  91.                 (dotimes (x 40)
  92.                   (setf tobemutated1 (nth (random 100) populationsorted))
  93.                   (setf tobemutated2 (nth (random 100) populationsorted))
  94.                   (setf cutsite (random (length tobemutated1)))
  95.                   (setf mutatedpop1 (append (subseq tobemutated1 0 cutsite) (subseq tobemutated2 cutsite (length tobemutated1))))
  96.                   (setf mutatedpop2 (append (subseq tobemutated2 0 cutsite) (subseq tobemutated1 cutsite (length tobemutated2))))
  97.                   (push mutatedpop1 mutatedpop80)
  98.                   (push mutatedpop2 mutatedpop80)
  99.                 )
  100.                 mutatedpop80
  101.         )
  102. )
  103.        
  104. (main)