;; AI Final Project ;; Module: Cellular Automata 1D with history ;; CSC 466 - Graci ;; Jacob Peck - 20110313 (defclass ca () ( (cells :accessor ca-cells :initarg :cells :initform 'NIL) (oldcells :accessor ca-oldcells :initarg :oldcells :initform 'NIL) (rule :accessor ca-rule :initarg :rule :initform #'rule-86) ) ) (defclass cell () ( (left :accessor cell-left :initarg :left :initform 'NIL) (right :accessor cell-right :initarg :right :initform 'NIL) (state :accessor cell-state :initarg :state :initform 0) (history :accessor cell-history :initarg :history :initform '()) ) ) (defmethod make-cell ((state t)) (make-instance 'cell :state state :history (list state)) ) (defmethod make-ca ((population integer) (states list) (rule function) &aux temp cells oldcells ca) (setf cells ()) (setf oldcells ()) (dotimes (i population NIL) (setf temp (pick states)) (setf cells (append cells (list (make-cell temp)))) (setf oldcells (append oldcells (list (make-cell temp)))) ) (assign-neighbors cells) (assign-neighbors oldcells) (make-instance 'ca :cells cells :oldcells oldcells :rule rule) ) ; to do (defmethod assign-neighbors ((l list) &aux cell) (dotimes (i (length l) NIL) (setf cell (nth i l)) (cond ((= i 0) (setf (cell-left cell) (car (last l))) (setf (cell-right cell) (nth (+ i 1) l)) ) ((= i (- (length l) 1)) (setf (cell-left cell) (nth (- i 1) l)) (setf (cell-right cell) (first l)) ) (t (setf (cell-left cell) (nth (- i 1) l)) (setf (cell-right cell) (nth (+ i 1) l)) ) ) ) NIL ) (defmethod iterate-ca ((system ca) &aux l old rule) (setf rule (ca-rule system)) (setf l (ca-cells system)) (setf old (ca-oldcells system)) (dotimes (i (length l) NIL) (apply rule (list (nth i l) (nth i old))) ) (update-old-list l old) (setf (ca-cells system) l) (setf (ca-oldcells system) old) NIL ) (defmethod update-old-list ((new list) (old list)) (dotimes (i (length new) NIL) (setf (cell-state (nth i old)) (cell-state (nth i new))) (setf (cell-history (nth i old)) (cell-history (nth i new))) ) NIL ) (defmethod rule-86 ((element cell) (old cell) &aux left right state) ; rule 86 ; XXX XX- X-X X-- -XX -X- --X --- ; - X - X - X X - (setf state (cell-state old)) (setf left (cell-state (cell-left old))) (setf right (cell-state (cell-right old))) (if (or (and (eq left '-) (eq state 'X) (eq right '-)) ;-X- => X (and (eq left '-) (eq state '-) (eq right 'X)) ;--X => X (and (eq left 'X) (eq state '-) (eq right '-)) ;X-- => X (and (eq left 'X) (eq state 'X) (eq right '-)) ;XX- => X ) (progn (setf (cell-state element) 'X) (setf (cell-history element) (append (cell-history element) (list 'X))) ) (progn (setf (cell-state element) '-) (setf (cell-history element) (append (cell-history element) (list '-))) ) ) NIL ) (defmethod visualize-ca ((system ca) &aux l) (setf l (ca-cells system)) (dolist (element l NIL) (format t "~A" (cell-state element)) ) (terpri) NIL )