; ; 2D cellular automata code, randomly populated ; ; Scott Wilson, Feb 02, 2000 rev 1 ; rswilson@ccrma.stanford.edu ; ; Use: (setf my-ca (ca size)) Random population ; (setf my-ca (ca 3 :pattern ((1 0 1) (0 1 0) (1 0 1)))) set population ;where size is the number of rows and columns ; ; (ca-step my-ca) Step the simulation ; (ca-print my-ca) Pretty print the array ; (ca-value my-ca row col) Retrieve a value from the array ; ; (ca-sum-col my-ca col) Sum a row/col and return the result ; (ca-sum-row my-ca row) ; ; (ca-col-list my-ca col) Return a row or column as a list ; (ca-row-list my-ca row) ; ; (ca-col-stream my-ca col) Return a row or column as a cyclic item stream ; (ca-row-steam my-ca row) ; ; Next thing to do is be able to read in starting patterns from a file ; ; Changes rev 1: Fixed a bug where I was counting the cell in question as one ; of it's neighbours, added ca-fill to enable specifying a pattern ; as list of lists. ; rev2 (nando, feb 14 2000): ; - changed macros to functions, general cleanup, gathered index limits from matrix ; dimensions ; rev3 (nando, feb 6 2001): ; - adapted to cm-2.0, fixed ca-col-list and ca-row-list (indexes were inverted) ; fixed ca-col-sum, ca-row-sum #| (setf x (ca-load-pattern (ca '(30 60) :populate nil) (read-pattern "/usr/lib/xlife/mediumfish.l"))) (loop for col from 0 below (ca-cols x) do (loop for row from 0 below (ca-rows x) do (format t "~s" (ca-value x col row))) (format t "~%")) (with-sound(:scaled-to 0.2) (loop repeat 32 for time from 0 by 0.1 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t ".") (fm-violin time 0.1 (hertz (+ 30 row))(* 0.1 (/ col (ca-cols x)))))))) (format t "~%") (ca-step x))) (with-sound() (loop repeat 22 for time from 0 by 0.1 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t "~s:~s " row col) (fm-violin time 0.1 (hertz (+ 30 col))(* 0.1 (/ row (ca-rows x)))))))) (ca-step x))) (setf x (ca-load-pattern (ca '(30 60) :populate nil) (read-pattern "/usr/lib/xlife/12gliders.l"))) (with-sound(:scaled-to 0.2) (loop repeat 22 with count = 0 for time from 0 by 0.1 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t ".") (fm-violin time 0.1 (hertz (+ 30 row)) 0.1 :fm-index (* 4 (/ col (ca-cols x)))))))) (format t ":~%") (ca-step x))) (with-sound(:scaled-to 0.2) (loop repeat 60 with count = 0 for time from 0 by 0.1 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t ".") (fm-violin time 0.1 (hertz (+ 30 row)) 0.1 :fm-index (* 4 (/ col (ca-cols x)))))))) (format t ":~%") (loop repeat 4 do (ca-step x)))) (with-sound(:scaled-to 0.2) (loop repeat 32 for time from 0 by 0.1 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t ".") (fm-violin time 0.1 (hertz (+ 30 (- 70 row)))(* 0.1 (/ col (ca-cols x)))))))) (format t "~%") (ca-step x))) (with-sound(:scaled-to 0.2) (loop repeat 100 for time from 0 by 0.05 do (loop for row from 0 below (ca-rows x) do (loop for col from 0 below (ca-cols x) do (if (= (ca-value x col row) 1) (progn (format t ".") (fm-violin time 0.08 (hertz (+ 30 row))(* 0.1 (/ col (ca-cols x)))))))) (format t "~%") (ca-step x))) |# (defstruct cellaut cells generation ) (defun ca (size &key (pattern) (populate t)) (format t "created new Cellular Automata of size ~s ~%" size) ;; specify list of two dimensions, or a number for a square matrix (let* ((arr (make-array (if (listp size) (if (> (length size) 2) (error "max of two dimensions, ~s supplied in ~s" (length size) size) size) (list size size)) :initial-element 0)) (ca (make-cellaut :generation 0 :cells arr))) (if populate (if (not pattern) (ca-populate ca) (ca-fill ca pattern)) ca))) (defun ca-step (ca) (let* ((dims (array-dimensions (cellaut-cells ca))) (cells (make-array dims :initial-element 0)) (iend (first dims)) (jend (second dims))) (loop for i from 0 below iend do (loop for j from 0 below jend do (let* ((ncount (ca-neighbour-count ca i j)) (alive (ca-value ca i j))) ;; (format t "ncount ~s ~%" ncount) (cond ((and (= alive 1)(< ncount 2)) ;; dies of loneliness (setf (aref cells i j) 0)) ((and (= alive 1)(> ncount 3)) ;; dies of starvation (setf (aref cells i j) 0)) ((and (= alive 0)(eq ncount 3)) ;; a new cell is born (setf (aref cells i j) 1)) (t ;; the new cells stays in the same state (setf (aref cells i j)(aref (cellaut-cells ca) i j))))))) (setf (cellaut-cells ca) cells) (incf (cellaut-generation ca)) ca)) (defun ca-birth (ca row col) ;; (format t "birth ~s ~s ~%" row col) (setf (aref (cellaut-cells ca) row col) 1)) (defun ca-die (ca row col) ;; (format t "die ~s ~s ~%" row col) (setf (aref (cellaut-cells ca) row col) 0)) (defun ca-neighbour-count (ca row col) (- (loop for r from (- row 1) to (+ row 1) summing (ca-row-neighbour-count ca r col)) (ca-value ca row col) ; don't actually count the cell in question ) ) (defun ca-row-neighbour-count (ca row idx) (loop for i from (- idx 1) to (+ idx 1) summing (ca-value ca row i))) (defun ca-value (ca idx1 idx2) ;; (format t "~s ~s ~%" idx1 idx2) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims)) (jend (second dims))) (if (eq iend idx1) (setf idx1 0)) (if (eq -1 idx1) (setf idx1 (- iend 1))) (if (eq jend idx2) (setf idx2 0)) (if (eq -1 idx2) (setf idx2 (- jend 1))) (aref (cellaut-cells ca) idx1 idx2))) (defun ca-populate (ca) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims)) (jend (second dims))) (loop for i from 0 below iend do (loop for j from 0 below jend do (setf (aref (cellaut-cells ca) i j)(random-bit)))) ca)) (defun ca-fill (ca pattern) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims)) (jend (second dims))) (if (/= (length pattern) iend) (error "pattern does not match automata dimensions")) (loop for i from 0 below iend for row in pattern do (if (/= (length row) jend) (error "pattern does not match automata dimensions")) (loop for j from 0 below jend for bit in row do (setf (aref (cellaut-cells ca) i j) bit))) ca)) ; utility functions... (defun ca-cols (ca) (first (array-dimensions (cellaut-cells ca)))) (defun ca-rows (ca) (second (array-dimensions (cellaut-cells ca)))) (defun ca-col-sum (ca col) (let* ((dims (array-dimensions (cellaut-cells ca))) (jend (second dims))) (loop for i from 0 below jend summing (ca-value ca col i)))) (defun ca-row-sum (ca row) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims))) (loop for i from 0 below iend summing (ca-value ca i row)))) (defun ca-col-list (ca col) (let* ((dims (array-dimensions (cellaut-cells ca))) (jend (second dims))) (loop for i from 0 below jend collecting (ca-value ca col i)))) (defun ca-row-list (ca row) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims))) (loop for i from 0 below iend collecting (ca-value ca i row)))) #| (defun ca-col-pattern (ca col &key (pattern 'cyclic)) (new pattern in pattern of (ca-col-list ca col))) (defun ca-row-pattern (ca row &key (pattern 'cyclic)) (new pattern in pattern of (ca-row-list ca row))) |# (defun ca-print (ca) (let* ((dims (array-dimensions (cellaut-cells ca))) (iend (first dims)) (jend (second dims))) (loop for i from 0 below iend do (loop for j from 0 below jend do (format t "~s " (if (eq 1 (ca-value ca i j)) 'o '+))) (format t "~%")))) (defun random-bit () (if (> (random 1.0) 0.5) 1 0))