Autómato celular em 1D

Implementação em CL de um autómato celular 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)

((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ção¹ 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, 1d

Criado/Created: NaN

Última actualização/Last updated: 10-10-2022 [14:25]

Voltar à página inicial.