;
; 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))