Using Loop To Evolve

Published on May 06, 2012



(loop for i
      below 5
      sum i) 
;counting from a starting point to an ending point
(loop for i
      from 5
      to 10
      sum i)
;iterating through values in a list
(loop for i
      in '(100 20 3)
      sum i)
;doing stuff in a loop
(loop for i
      below 5
      do (print i))
;dong stuff under certain conditions
(loop for i
      below 10
      when (oddp i)
      sum i)
;breaking out of a loop early
(loop for i
      from 0
      do (print i)
      when (= i 5)
      return 'falafel)
;collecting a list of values
(loop for i
      in '(2 3 4 5 6)
      collect (* i i))
;using multiple for clauses
;loop 10 times
(loop for x below 10
      for y below 10
      collect (+ x y))
;nested loops for 10x10 times
(loop for x below 10
      collect (loop for y below 10
                    collect (+ x y)))
;track the index number of items in a list
(loop for i
      from 0
      for day
      in '(monday tuesday wednesday thursday friday saturday sunday)
      collect (cons i day))


Using Loop to Evolve


;;;The extent of the world
(defparameter *width* 100)
(defparameter *height* 30)
(defparameter *jungle* '(45 10 10 10))
(defparameter *plant-energy* 80)
;;;Growing plants in our world
;;cons cells should be compared with equal
(defparameter *plants* (make-hash-table :test #'equal))
;;Grow new plants
(defun random-plant (left top width height)
  (let ((pos (cons (+ left (random width)) (+ top (random height)))))
    (setf (gethash pos *plants*) t)))
(defun add-plants ()
  (apply #'random-plant *jungle*)
  (random-plant 0 0 *width* *height*))
;;;Creating animals
(defstruct animal x y energy dir genes)
;;x,y stand for the position
;;energy represent its energy,when the energy exhausted,it will die
;;dir is the direction it faced
;;genes decide the direction it will choose
;;Creating an animal in the center of the map
(defparameter *animals*
  (list (make-animal :x;we only use list to traverse animal,
                     ;its efficient enough.
                     (ash *width* -1)
                     (ash *height* -1)
                     (loop repeat 8
                           ;collect is OK??
                           collecting (1+ (random 10))))))
;;;Handling animal motion
(defun move (animal)
  (let ((dir (animal-dir animal))
        (x (animal-x animal))
        (y (animal-y animal)))
    (setf (animal-x animal) (mod (+ x
                                    (cond ((and (>= dir 2) (< dir 5)) 1)
                                          ((or (= dir 1) (= dir 5)) 0)
                                          (t -1))
    (setf (animal-y animal) (mod (+ y
                                    (cond ((and (>= dir 0) (< dir 3)) -1)
                                          ((and (>= dir 4) (< dir 7)) 1)
                                          (t 0))
    (decf (animal-energy animal))))
;;;Handling animal turning
(defun turn (animal)
  (let ((x (random (apply #'+ (animal-genes animal)))))
    ;;this was not easy to understand it,
    (labels ((angle (genes x)
               (let ((xnu (- x (car genes))))
                 (if (< xnu 0)
                   (1+ (angle (cdr genes) xnu))))))
      (setf (animal-dir animal)
            (mod (+ (animal-dir animal) (angle (animal-genes animal) x))
;;;Handling animal eating
(defun eat (animal)
  (let ((pos (cons (animal-x animal) (animal-y animal))))
    (when (gethash pos *plants*)
      (incf (animal-energy animal) *plant-energy*)
      (remhash pos *plants*))))
;;;Handling animal reproduction
(defparameter *reproduction-energy* 200)
(defun reproduce (animal)
  (let ((e (animal-energy animal)))
    (when (>= e *reproduction-energy*)
      (setf (animal-energy animal) (ash e -1))
      (let ((animal-nu (copy-structure animal));浅复制命令
            (genes (copy-list (animal-genes animal)))
            (mutation (random 8)))
        (setf (nth mutation genes) 
              (max 1 (+ (nth mutation genes) (random 3) -1)))
;This means the gene value will change plus or minus one, or
;stay the same.
        (setf (animal-genes animal-nu) genes)
        (push animal-nu *animals*)))))
;;;Simulating a day in our world
(defun update-world ()
  (setf *animals* (remove-if (lambda (animal)
                               (<= (animal-energy animal) 0))
  (mapc (lambda (animal)
          (turn animal)
          (move animal)
          (eat animal)
          (reproduce animal))
;;;Drawing our world
;;;This has low performance but will not matters
(defun draw-world ()
  (loop for y
        below *height*
        do (progn 
             (fresh-line);outputs a newline only if the output-stream
             ;is not already at the start of a line
             (princ "|")
             (loop for x
                   below *width*
                   do (princ (cond ((some (lambda (animal)
                                            (and (= (animal-x animal) x)
                                                 (= (animal-y animal) y)))
                                   ((gethash (cons x y) *plants*) #\*)
                                   (t #\space))))
             (princ "|"))))
;;;Creating a user interface
(defun evolution ()
  (let ((str (read-line)))
    (cond ((equal str "quit") ())
;Recall Conrad’s Rule of Thumb for Comparing Stuff
;use eq for symbols
;use equal for everything else
          (t (let ((x (parse-integer str :junk-allowed t)))
               (if x
                 (loop for i
                       below x
                       do (update-world)
                       if (zerop (mod i 1000))
                       do (princ #\.))




Evaluation took:
  789.430 seconds of real time
  459.846682 seconds of total run time (456.986869 user, 2.859813 system)
  [ Run times consist of 18.864 seconds GC time, and 440.983 seconds non-GC time. ]
  58.25% CPU
  1,785,005,533,676 processor cycles
  125,872,778,768 bytes consed


Looks good however,