✍ Foi o Twitter

Autómato celular em 2D

Foi o Twitter, a ele se deve toda a responsabilidade da motivação desta entrada, ou antes, posso antes atribuir a responsabilidade e esta entrada do blog http://www.bestinclass.dk/ e à minha consequentemente leitura.

A ideia é implementar em Emacs Lisp um autómato celular a duas dimensões que evolui em paralelo, i.e., todas os estados de todas as células são actualizadas em simultâneo. Acho que não conseguirei bater as 67 linhas de código em Clojure, mas o exercício vale só por si (e o número de linhas não serve como medida). Vou seguir na apresentação do programa a mesma estrutura da referência anterior. Vejamos então...

O autómato vive num tabuleiro 10x10 que é construído através de da especificação (setq dim-board '(9 9))

(defun make-board (dim-board)
  (let ((boardv nil) (i 0))
    (while (< i (car dim-board))
      (let ((j 0))
        (while (< j (cadr dim-board))
          (setq boardv (cons (list (list i j) (random 3)) boardv))
          (setq j (+ j 1))))
      (setq i (+ i 1)))
    boardv))

(defun board-dimensions (board)
  (list (+ 1 (caaar board))
        (+ 1 (cadaar board))))
Note-se que em vez de usar uma matriz 10x10 para representar o estado do autómato vou usar uma lista com elementos do tipo ((x y) status), e que define a posição e o estado de cada célula (nota: apesar de o tabuleiro ser construído da maneira usual, representando uma matriz com as entradas ordenadas da maneira usual, o código seguinte não usa esta ordenação, aliás não usa qualquer outra).

A função seguinte retorna o estado da célula na posição coord, onde as coordenadas são dadas por uma lista do tipo (x y).

(defun find-state-cell (coord board)
  (cadr  (assoc (list (mod (car coord) (car (board-dimensions board)))
                     (mod (cadr coord) (cadr (board-dimensions board))))
         board)))
Note-se que, para evitar a construção de sub-matrizes de vizinhos em cada célula, vou usar as coordenadas definidas sobre um torus através das congruências modulo dim-board mais um.

As regras de evolução são construídas a partir dos estados dos vizinhos de cada célula que se obtêm de

(defun get-neighbours (cell board)
  (let ((x (caar cell)) (y (cadar cell)))
    (list
     (find-state-cell (list (- x 1) (+ 1 y)) board)
     (find-state-cell (list x (+ 1 y)) board)
     (find-state-cell (list (+ x 1) (+ 1 y)) board)
     (find-state-cell (list (- x 1) y) board)
     (find-state-cell (list x y) board)
     (find-state-cell (list (+ x 1) y) board)
     (find-state-cell (list (- x 1) (- y 1)) board)
     (find-state-cell (list x (- y 1)) board)
     (find-state-cell (list (+ x 1) (- y 1)) board))))
Esta é talvez a função menos elegante que aqui se pode encontrar. Uma alternativa seria definir 4 funções que viajassem a partir de uma dada célula, para cima, baixo, esquerda e direita, ou ainda como vem na referência (só agora percebi o código, não sei nada de Clojure...) Veja-se a versão final no fim do texto.

As regras estão definidas na função apply-rule-to-cell que tem como input uma célula ((x y) status e tabuleiro, retorna a célula modificada ((x y) nem_status) de acordo com as regras

(defun apply-rule-to-cell (cell board)
  (cond ((and (= (find-state-cell (car cell) board) 0)
              (= (sum (get-neighbours cell board)) 2))
         (list (car cell) 1))
        ((= (find-state-cell (car cell) board) 1)
         (list (car cell) 2))
        ((= (find-state-cell (car cell) board) 2)
         (list (car cell) 0))
        (t
         (list (car cell) 0))))

A actualização de todas as células é obtida através de

(defun apply-rule-to-board (board)
  (mapcar #'(lambda  (x) (apply-rule-to-cell x board))
          board))

E já está.

Antes que me esqueça preciso desta função auxiliar que soma uma lista de números:

(defun sum (lst)
  (cond (lst
         (+ (car lst) (sum (cdr lst))))
        (t
         0)))

Aqui fica a versão final das funções anteriores (algumas funções desapareceram :) )

(defun make-board (dim-board)
  (let ((boardv nil) (i 0))
    (while (< i (car dim-board))
      (let ((j 0))
        (while (< j (cadr dim-board))
          (setq boardv (cons (list (list i j) (random 3)) boardv))
          (setq j (+ j 1))))
      (setq i (+ i 1)))
    boardv))

(defun find-state-cell (coord board)
  (cadr  (assoc (list (mod (car coord)
                           (+ 1 (apply 'max (mapcar
                                             (lambda (x) (caar x)) board))))
                      (mod (cadr coord-x)
                           (+ 1 (apply 'max (mapcar
                                             (lambda (x) (cadar x)) board)))))
                board)))

(defun sum (lst)
  (cond (lst
         (+ (car lst) (sum (cdr lst))))
        (t
         0)))

(defun distribute (n lst)
  (cond ((null lst)
         nil)
        (t
         (cons (list n (car lst))
               (distribute n (cdr lst))))))

(defun cartesian-prod (lst1 lst2)
  (cond ((null lst1)
         nil)
        (t
         (append (distribute (car lst1) lst2)
                 (cartesian-prod (cdr lst1) lst2)))))

(defun get-neighbours-values (cell board)
  (let ((lst1 (mapcar (lambda (x) (+ (caar cell) x)) '(-1 0 1)))
        (lst2 (mapcar (lambda (x) (+ (cadr cell) x)) '(-1 0 1))))
    (mapcar (lambda (x) (find-state-cell x board-x)) (cartesian-prod lst1 lst2))))

(defun apply-rule-to-cell (cell board)
  (cond ((and (= (find-state-cell (car cell) board) 0)
              (= (sum (get-neighbours-values cell board)) 2))
         (list (car cell) 1))
        ((= (find-state-cell (car cell) board) 1)
         (list (car cell) 2))
        ((= (find-state-cell (car cell) board) 2)
         (list (car cell) 0))
        (t
         (list (car cell) 0))))

(defun apply-rule-to-board (board)
  (mapcar #'(lambda  (x) (apply-rule-to-cell x board))
          board))

E tudo corre bem com "apenas" 52 linhas.

(setq board-x (make-board '(9 9)))

(apply-rule-to-board board-x)

O desperdício é evidente por ter de construir as funções sum, distribute e cartesian-prod. Happy hacking!

Palavras chave/keywords: Brians' Brain, 2D, Emacs Lisp

Criado/Created: 18-04-2010 [00:00]

Última actualização/Last updated: 23-01-2017 [09:18]


GNU/Emacs

1999-2017 (ç) Tiago Charters de Azevedo

São permitidas cópias textuais parciais/integrais em qualquer meio com/sem alterações desde que se mantenha este aviso.

Verbatim copying and redistribution of this entire page are permitted provided this notice is preserved.