;;********************************************

;;********************************************

;;////////////////////////////////////////////

;;Notes on Cellular Automata CA

;;////////////////////////////////////////////

;;Mauricio Rodriguez - 2006

;;////////////////////////////////////////////

;;marod@ccrma.stanford.edu

;;////////////////////////////////////////////

;;********************************************

;;********************************************

#|

******************************

******************************

Use and copying of this software and preparation of derivative works

based upon this software are prohibited unless permission of the author.

Suggestions, comments and bug reports are welcome. Please address email to:

marod@ccrma.stanford.edu

******************************

******************************

|#

;;Main:

;; cellular-automata-generation [n seed]

;;(cellular-automata-generation 2 '(0 1 0 1 1 0 1))

;;Code:

(defun cellular-rules (pattern)

(cond

((equal pattern '(1 1 1)) 0)

((equal pattern '(1 1 0)) 0)

((equal pattern '(1 0 1)) 0)

((equal pattern '(1 0 0)) 1)

((equal pattern '(0 1 1)) 1)

((equal pattern '(0 1 0)) 1)

((equal pattern '(0 0 1)) 1)

((equal pattern '(0 0 0)) 0)))

(defun wrap-cells (list)

(append (last list) list (list (first list))))

(defun group-by-three* (list)

(if (endp list)

nil

(cons (List (first list) (second list) (third list))

(group-by-three* (rest list)))))

(defun group-by-three (list)

(let ((current-list (group-by-three* list)))

(loop for x in current-list

when (not (or (equal (second x) nil) (equal (third x) nil)))

collect x)))

(defun get-child-cells (parent-list)

(loop for x in parent-list

collect (cellular-rules x)))

(defun cellular-automata-generation (n seed)

(do ((counter n (decf counter))

(current-seed

(wrap-cells seed)

(wrap-cells (get-child-cells (group-by-three current-seed))))

(output nil (cons (butlast (rest current-seed)) output)))

((= 0 counter) (reverse output))))

;;(cellular-automata-generation 2 '(0 1 0 1 1 0 1))

(defun random-cell-generation* ()

(elt '(0 1) (random 2)))

(defun random-cell-generation (n)

(loop repeat n

collect (random-cell-generation*)))

;;(random-cell-generation 6)

;;////////////////////////////////////////////

;;To draw cells in PWGL:

;;////////////////////////////////////////////

(defun make-pairs* (list)

(if (endp list)

nil

(cons (List (first list) (second list))

(make-pairs* (rest list)))))

(defun make-pairs (list)

(let ((current-list (make-pairs* list)))

(loop for x in current-list

when (not (equal (second x) nil))

collect x)))

(defun build-column-member (member)

(append member (reverse member)))

(defun column-line (n)

(loop for x in (make-pairs (loop for y from 0 to n collect y))

collect (build-column-member x)))

(defun build-row-member (member)

(list (first member) (first member) (second member) (second member)))

(defun row-line (n)

(loop for x in (make-pairs (loop for y from 1 to (+ n 1) collect y))

collect (build-row-member x)))

(defun delta-x (n-row n-column)

(let ((column (column-line n-column)))

(loop repeat n-row

append column)))

(defun delta-y (n-row n-column)

(loop for x in (row-line n-row)

append (loop repeat n-column

collect x)))

(defun cell-color* (element)

(if (= element 1)

'(0.0 0.0 0.0)

'(1.0 1.0 1.0)))

#|

(defun cell-color (generated-ca-list)

(let ((generated-ca (loop for x in generated-ca-list

append x)))

(loop for y in generated-ca

collect (cell-color* y))))

|#

(defun cell-color** (generated-ca-member)

(loop for x in generated-ca-member

collect (cell-color* x)))

(defun cell-color (generated-ca-list)

(loop for x in (reverse (loop for y in generated-ca-list

collect (cell-color** y)))

append x))

;;(cell-color '((0 1 0 1 1 0 1) (0 1 0 1 0 0 1)))