;
; 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/ccrma/web/html/courses/220b/topics/cellularautomata/examples/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))