Emacs-lisp is a pretty functional language for managing Emacs and automating complex tasks within it, particularly to do with text processing. It’s probably not wise to use it for more general programming or analytical tasks, but every now and then (when I need to procrastinate, mostly) I get carried away.
A few years ago I was reading Peter Hedstrom’s book, Dissecting the Social, and realised his Desires-Believes-Acts model (a kind of cellular automaton) would be easy enough to implement. More recently, I noticed that Emacs’ tools for displaying simple games like Tetris (do “M-x tetris”) would permit a clean display.
In Hedstrom’s model, every cell in a grid may desire an outcome, and may believe they are able to achieve it. If they do both, they act. Belief and desire depend on the beliefs and desires of your neighbours. Generally, even starting from random and low distributions of belief and desire, within a number of iterations stable configurations emerge, with systematic segregation; often everyone acts in the end but sometime stable oscillating systems emerge.
Without further comment, here is the Emacs lisp code to implement it: evaluate this code, do “M-x dbagg” and press “a” repeatedly to iterate.
(eval-when-compile (require 'cl))
(require 'gamegrid)
(require 'tetris)
(defvar *size* 30)
(defvar *grid* (make-vector *size* ()))
(defvar *new-grid* (make-vector *size* "!"))
(defvar *iteration* 0)
(defvar *y-offset* 0)
(defvar *x-offset* 0)
(defun show-grid ()
(dotimes (i *size*)
(dotimes (j *size*)
(let ((cell (aref (aref *grid* (mod (+ i *x-offset*) *size*)) (mod (+ j *y-offset*) *size*))))
(gamegrid-set-cell i j
(cond
((string= cell " ") 7) ; neither
((string= cell ".") 2) ; believes
((string= cell "-") 4) ; desires
((string= cell "X") 5))))))) ; both
(defun initialise-grid (p1 p2 p3)
(dotimes (i *size*)
(setf (aref *grid* i) (make-vector *size* nil))
(setf (aref *new-grid* i) (make-vector *size* nil)))
(dotimes (i *size*)
(dotimes (j *size*)
(setf (aref (aref *grid* i) j) (random-init p1 p2 p3)))))
(defun copy-new-grid ()
(dotimes (i *size*)
(dotimes (j *size*)
(setf (aref (aref *grid* i) j)
(aref (aref *new-grid* i) j)))))
(defun random-init (p1 p2 p3)
(let ((x (/ (random 10000) 10000.0)))
(cond
((< x p1) " ")
((< x p2) ".")
((< x p3) "-")
(t "X"))))
(defun believes-p (cell)
(or (string= cell ".")
(string= cell "X")))
(defun desires-p (cell)
(or (string= cell "-")
(string= cell "X")))
(defun update-cell (i j)
(let ((above (aref (aref *grid* (mod (- i 1) *size*)) j ))
(below (aref (aref *grid* (mod (+ i 1) *size*)) j ))
(left (aref (aref *grid* i ) (mod (- j 1) *size*)))
(right (aref (aref *grid* i ) (mod (+ j 1) *size*)))
(believes 0)
(desires 0))
(if (believes-p left ) (incf believes))
(if (believes-p right) (incf believes))
(if (believes-p above) (incf believes))
(if (believes-p below) (incf believes))
(if (desires-p left ) (incf desires))
(if (desires-p right) (incf desires))
(if (desires-p above) (incf desires))
(if (desires-p below) (incf desires))
(setf (aref (aref *new-grid* i) j) (cond
((and (< believes 2) (< desires 2)) " ") ((and (>= believes 2) (< desires 2)) ".")
((and (< believes 2) (>= desires 2)) "-")
((and (>= believes 2) (>= desires 2)) "X")
(t "!")))))
(defun update-grid ()
(dotimes (i *size*)
(setf (aref *new-grid* i) (make-vector *size* nil))
(dotimes (j *size*)
(update-cell i j)))
(copy-new-grid))
(defun dba-start ()
(interactive)
(initialise-grid 0.64 0.8 0.96)
(switch-to-buffer (get-buffer-create "*GRID*"))
(gamegrid-init (tetris-display-options))
(gamegrid-init-buffer *size* *size* 9)
(setq *iteration* 1)
(show-grid))
(defun update-grid-vis (&optional niter)
(interactive "p")
(if (null niter) (setq niter 1))
(dotimes (i niter)
(incf *iteration*)
(update-grid))
(show-grid))
(defun summarise-grid ()
(let ((space 0)
(dot 0)
(dash 0)
(x 0))
(dotimes (i *size*)
(dotimes (j *size*)
(cond
((string= (aref (aref *grid* i) j) " ") (incf space))
((string= (aref (aref *grid* i) j) ".") (incf dot))
((string= (aref (aref *grid* i) j) "-") (incf dash))
((string= (aref (aref *grid* i) j) "X") (incf x)))))
(format " %4d %4d %4d %4d; %4d" space dot dash x *iteration*)))
(define-derived-mode
dba-mode
fundamental-mode
"DBA"
"Mode for desires-beliefs-actions game-of-life"
)
(define-key dba-mode-map "n" 'dba-start)
(define-key dba-mode-map "a" 'update-grid-vis)
(define-key dba-mode-map '[right] 'shift-grid-right)
(define-key dba-mode-map '[left] 'shift-grid-left)
(define-key dba-mode-map '[up] 'shift-grid-up)
(define-key dba-mode-map '[down] 'shift-grid-down)
(defun dbagg ()
"Hedstrom's Desires/Believes/Acts model.
Black cells neither believe nor desire, blue believes, yellow
desires, green both believes and desires and therefore acts.
Believing and desiring at t+1 depends on your neighbours at t.
Press \"n\" to initialise a new random grid, \"a\" to iterate.
\"a\" with a prefix argument will iterate by that many time
units; for instance, \"C-u 100 a\" will jump 100 iterations.
Arrow keys scroll through the gird, which is a torus (i.e.,
Pacman-style world).
"
(interactive)
(switch-to-buffer "*GRID*")
(dba-mode)
(dba-start))
(defun shift-grid-left ()
(interactive)
(setq *x-offset* (+ *x-offset* 1))
(show-grid))
(defun shift-grid-right ()
(interactive)
(setq *x-offset* (- *x-offset* 1))
(show-grid))
(defun shift-grid-up ()
(interactive)
(setq *y-offset* (+ *y-offset* 1))
(show-grid))
(defun shift-grid-down ()
(interactive)
(setq *y-offset* (- *y-offset* 1))
(show-grid))
;; Apr 28 2013 16:52:08
;; Copyright Brendan Halpin 2013
;; Consider this GPLed