Autómato celular em 1D
Depois de implementar um autómato celular em 2D resolvi agora fazer o mesmo para um em 1D. A abordagem é diferente, mais no espírito deste texto.
Um autómato celular é definido por uma lista de células que tomam valores discretos, neste caso 0 ou 1,
(0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)e uma regra de evolução que especifica como se transformam os estados de cada célula de acordo com os estados das células vizinhas. Esta lista é construída com
(defun make-board (m) (concatenate 'list nil (zeros (floor (/ m 2.0))) '(1) (zeros (floor (/ m 2.0)))))
Toma-se, neste exemplo, como vizinhos de uma dada célula as células
imediatamente antes e depois dessa célula. As regras de evolução são definidas
através da lista ((c1 c2 c3) new_state) ... (c1 c2 c3) new_state))
.
A regra 30 é dada por
(((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0) ((1 1 0) 0) ((1 1 1) 0))A especificação dos vizinhos determina o número de autómatos celulares com três vizinhos, i.e., 256. Logo cada regra de evolução é determinada pela representação em base 2 de um número entre 0 e 255. Isso é feito através de
(defun to-bin (x) (cond ((= 0 x) 0) (t (let* ((q (floor (/ x 2.))) (r (- x (* 2 q)))) (cond ((= q 0) '(1)) (t (cons r (to-bin q))))))))Claro que
(to-bin 30)
dá (0 1 1 1 1)
e como temos 8 possibilidades de estados
para três células precisamos de uma codificação em 8 bits, i.e., usando
(defun zeros (n) (cond ((= n 0) nil) (t (cons '0 (zeros (- n 1)))))) (defun length-to-bin (n x) (cond ((= n 0) 0) (t (append (to-bin x) (zeros (- n (length (to-bin x))))))))através de
(length-to-bin 8 30)
para dar (0 1 1 1 1 0 0 0)
. Não
é difícil obter-se a representação em qualquer base b
com
(defun dec-to-b (x b) (cond ((= x 0) 0) (t (let* ((q (floor (/ x (* b 1.0)))) (r (- x (* b q)))) (cond ((= q 0) 1) (t (cons r (dec-to-b q b))))))))
Voltando então ao tópico principal.
Como a regra de evolução é dada na forma
(((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0) ((1 1 0) 0) ((1 1 1) 0))a maneira mais simples de a aplicar é converter o estado do autómato, por exemplo,
(0 0 1 0 0)em
((0 0 1) (0 1 0) (1 0 0))Ora isso é feito usando as seguintes funções
(defun nest-car (lst n) "?anti-cdr?" (cond (lst (let ((m (- n 1))) (cond ((= m 0) (list (car lst))) (t (cons (car lst) (nest-car (cdr lst) (- n 1))))))) (t nil))) (defun partition1 (lst n m) (cond ((<= m (length lst)) (cond (lst (cons (nest-car lst n) (partition1 (nthcdr m lst) n m))) (t nil))) (t nil))) (defun partition (lst n m) (mapcan #'(lambda (x) (and (= n (length x)) (list x))) (partition1 lst n m)))que fazem a partição1 de
(0 0 1 0 0)
em ((0 0 1) (0 1 0) (1 0 0))
, i.e., em
grupos de 3 com um off-set de 1
, através de (partition '(0 0 1 0 0) 3 1)
.
Com tudo o que já definimos vejamos então como construir a regra a que
corresponde um número n
(defun nth-ca-rule (n) (labels ((3-tuple (bin-n 3tuple) (cond (3tuple (cons (list (car 3tuple) (car bin-n)) (3-tuple (cdr bin-n) (cdr 3tuple))))))) (let* ((bin-x (to-bin n)) (bin-n (length-to-bin 8 n))) (3-tuple bin-n '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))))))Assim dado a lista de regras de evolução verifica-se se alguma é aplicável ao primeiro elemento da lista particionada
((0 0 1) (0 1 0) (1 0 0))
, se sim
aplica-se a regra correspondente, através de
(defun ca-apply-car (3tuple rules) (cond ((equal 3tuple (caar rules)) (cadar rules)) (t (ca-apply-car 3tuple (cdr rules)))))e o mesmo para o resto da lista
(defun ca-apply (board rules) (let ((first-cell (list (car board))) (last-cell (list (car (reverse board))))) (concatenate 'list first-cell (mapcar #'(lambda (x) (ca-apply-car x rules)) (partition board 3 1)) last-cell)))
Falta só, para acabar, construir um iterador, que produz os sucessivos passos por aplicação da regra de evolução
(defun ca-run (board rules n) (cond ((= n 0) nil) (t (cons board (ca-run (ca-apply board rules) rules (- n 1))))))
Vejamos então um exemplo completo
> (setq xboard (make-board 30)) (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) > (setq xrules (nth-ca-rule 30)) (((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0) ((1 1 0) 0) ((1 1 1) 0)) > (setq xpar-board (partition xboard 3 1)) ((0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 1) (0 1 0) (1 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0))e 15 iterações dão
> (ca-run xboard xrules 15) ((0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0) (0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0) (0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0) (0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 0 0) (0 0 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 0) (0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 0) (0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0))
1. É semelhante ao comando com o mesmo nome do Mathematica.
Palavras chave/keywords: lisp, ca, autómato celular, 1dCriado/Created: NaN
Última actualização/Last updated: 10-10-2022 [14:25]
(c) Tiago Charters de Azevedo