(SBCL) ASCII Game of Life

Question

I'm implementing Conway's Game of Life in Lisp to familiarize myself with the language, with the eventual goal of hosting it on a website with a pretty GUI. I'm a hobbyist and inexperienced (this is my first project where there isn't a tutorial that can show me how to do everything I want), so any critique would really help me out.

Hook?: I want the simulation to be on an infinite grid. If the grid is infinite, I obviously can't try to iterate over the whole thing to check which cells need to live and die. Only live cells and cells immediately adjacent to live cells can potentially change their state, so instead of a set grid containing cells relative to the grid's origin, I've got a list of cells, and just update the position of all the cells in the list each turn relative to some point, which becomes the new origin.

null2 exists because (null '(list-of-structs)) ==> NIL

Also, is there some way to not have to type my-package::foo each time I want to use a function outside of a package? It's really cluttering up my code.

gol.asd

;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-

(defsystem "gol"
  :components ((:file "cell")
           (:file "convert-txt" ;not posted, empty file
              :depends-on ("cell"))
           (:file "ascii-display"
:depends-on ("cell"))))

cell.lisp

(defpackage :cell
  (:use :common-lisp)
  (:nicknames :c)
  (:export
   #:null2
   #:for
   #:min-x
   #:min-y
   #:max-x
   #:max-y
   #:cell-at
   #:turn
   #:o-change
   #:cell
   #:cell-p
   #:live
   #:x
   #:y
   #:make-cell))
(in-package :cell)

(defstruct (cell (:conc-name nil)
         (:print-function (lambda (c s d)
                    (declare (ignore d))
                    (format t "(~A ~A ~A) " (live c) (x c) (y c)))))
  (live nil) (x 0) (y 0))

(defvar *archive* nil
  "List containing all cells that have been in program.") ; fun to it over and make refs

(defmacro for (var start stop &body body)
  (let ((gstop (gensym)))
    `(do ((,var ,start (1+ ,var))
      (,gstop ,stop))
     ((> ,var ,gstop))
       ,@body)))

(defmacro for-adj (c &body body)
  (let ((gcol (gensym))
    (grow (gensym)))
    `(for ,gcol -1 1
       (for ,grow -1 1
     (when (not (and (zerop ,gcol) (zerop ,grow)))
       (let* ((adj-x (+ (x ,c) ,gcol))
          (adj-y (+ (y ,c) ,grow)))
         ,@body))))))

(defun null2 (lst)
  "Decides whether a list is nil based on length. nd"
  (zerop (length lst)))

(defun min-x (lst) (apply #'min (mapcar #'x lst)))
(defun min-y (lst) (apply #'min (mapcar #'y lst)))
(defun max-x (lst) (apply #'max (mapcar #'x lst)))
(defun max-y (lst) (apply #'max (mapcar #'y lst)))

(defun cell-at (x y lst)
  "Fetches cell occupying (x y), or puts one there. nd"
  (let* ((already? (mapcar (lambda (c) (when (and (= x (x c))
                          (= y (y c)))
                     c)) lst))
     (already? (remove-if-not (lambda (c) (cell-p c)) already?)))
    (if (null2 already?)
    (values (make-cell :x x :y y) nil)
    (values (car already?) t))))

(defun num-adj (c lst)
  "Returns the number of live cells adjacent to c. nd"
  (let ((count 0))
    (for-adj c
        (let ((adj (cell-at adj-x adj-y lst)))
      (when (live adj)
        (incf count))))
    count))

(defun validate (lst)
  "Pads all the cells in lst. nd"
  (let ((acc lst))
    (dolist (c acc acc)
      (for-adj c
    (multiple-value-bind (adj p)
        (cell-at adj-x adj-y acc)
      (unless p
        (push adj acc)))))))

(defun turn (lst)
  "Returns a list containing next turn's extant cells. nd"
  (let ((acc nil))
    (dolist (c (validate lst) (validate acc))
      (let ((nadj (num-adj c lst)))
    (when (and (live c) (or (= 2 nadj)
                (= 3 nadj)))
      (push c acc))
    (when (and (not (live c)) (= 3 nadj))
      (push (make-cell :live t :x (x c) :y (y c)) acc))))))

(defun o-change (lst &optional (o (car lst)))
  "Returns a list with the coordinates of each point updated to be relative to the point o. nd"
  (let ((acc nil)
    (x-change (- (x o)))
    (y-change (- (y o))))
    (dolist (c lst acc)
(push (make-cell :live (live c) :x (+ x-change (x c)) :y (+ y-change (y c))) acc))))

ascii-display.lisp

(defpackage :ascii-display
  (:use :common-lisp)
  (:nicknames :ad))
(in-package :ascii-display)

(defun rect (lst)
  "Returns the dimensions of a rectangular region containing all cells in lst. nd"
  (values (abs (- (c::max-x lst) (c::min-x lst)))
      (abs (- (c::max-y lst) (c::min-y lst)))))

(defun display (lst)
  "Prints lst to the screen. nd"
  (multiple-value-bind (x y)
      (rect lst)
    (let* ((top-left (c::cell-at (c::min-x lst) (c::max-y lst) lst))
       (lst (c::o-change lst top-left)))
      (c::for row 0 y
    (c::for col 0 x
      (let ((c (c::cell-at col (- row) lst)))
        (if (c::live c)
        (princ "C ")
        (princ "E "))))
    (terpri)))))

(defun cycle-input (prompt)
  (format t prompt)
  (let ((input (read)))
    (if (or (eql input 'n) (eql input 'q))
    input
    (cycle-input prompt))))

(defun cycle (lst &optional (turns 0))
  (format t
"Conway's Game of Life : TURN ~A
------------------------------~%" turns)
  (display lst)
  (format t
"------------------------------
'n' to continue simulation.
'q' to quit.~%")
  (let ((input (cycle-input "> ")))
    (when (eql input 'n)
(cycle (setf lst (c::turn lst)) (1+ turns)))))

Answer 1

I'm a little concerned about your underlying algorithm. While I generally advocate against premature optimization, sometimes things seem glaringly sub-optimal. Game of Life requires lots of looping through the cells, and having to do a linear search to get the cell at a particular coordinate probably makes this O(n³) or O(n⁴). This will be OK for small grids, but the reason you didn't use a fixed-size array was to allow unbounded grids. You probably should investigate more efficient ways to implement a sparse matrix than unordered lists (perhaps a hash table whose keys are (x y)).

The modularity almost makes it easy to substitute another implementation. cell-at hides the method of getting the cell at a location, but other code assumes that new cells can simply be pushed onto a list. When you perform this redesign, you should add a function for placing a cell at a location. I haven't gone this far in my update.

To avoid having to write c:: before all the symbols from the cell package, add the package to the :use list in ascii-display. Note also that if a symbol is exported, but you're not using the package, you can refer to it using a single :; :: is used when you want to access a non-exported symbol (this should be very rare, which is why it requires extra typing).

In the cell defstruct, I'm not crazy about your decision to use :conc-name nil. Exporting short symbols like x and y is a bad idea, because these are likely to conflict with local variables.

In the for macro, you can use loop to make the code simpler and clearer.

In for-adj, there's no need to use let*. While some CL programmers like to use let* all the time, I think the more common style is to only use it when there's a dependency between the variables. The * in the name marks it as a variant, and the reader is alerted to look for the dependency; when there isn't one, it's confusing.

Use (unless condition body) rather than (when (not condition) body).

It's not clear why you think you need your null2 function. If the argument is always a list, it's identical to null. Anyway, other changes I made to the code remove the call to it, so I just removed this function. It probably also shouldn't have been exported, since it was only needed internally.

In the min/max-x/y functions, you should not use apply, as you may exceed call-arguments-limit. Use reduce instead. This also allows you to use the :key argument instead of mapcar to get the slots, so you loop once instead of twice.

cell-at is particularly confusing. There's no need to loop over all cells and then filter them. Once you find the matching cell, just return it. Then if you finish the loop without finding the cell, create the new cell.

In validate, there's no need for the acc local variable. The function never uses lst, so this can simply be used in the loop.

In o-change, use mapcar to create a new list from the original list.

In cycle-input, you should display a message telling the user that they entered an invalid input, not just re-prompt silently. You can also make this function more general, by having it take an argument with the list of valid inputs, rather than hard-coding n and q. This does complicate the format string for displaying the message; see A Few Format Recipes for the explanation of that code.

In cycle, don't use recursion for potentially unbounded loops. Common Lisp is not necessarily tail-recursive, so just use a simple loop.

Here's the updated code:

cell.lisp

(defpackage :cell
  (:use :common-lisp)
  (:nicknames :c)
  (:export
   #:for
   #:min-x
   #:min-y
   #:max-x
   #:max-y
   #:cell-at
   #:turn
   #:o-change
   #:cell
   #:cell-p
   #:cell-live
   #:cell-x
   #:cell-y
   #:make-cell))
(in-package :cell)

(defstruct (cell (:print-function (lambda (c s d)
                                    (declare (ignore d))
                                    (format t "(~A ~A ~A) " (cell-live c) (cell-x c) (cell-y c)))))
  (live nil) (x 0) (y 0))

(defvar *archive* nil
  "List containing all cells that have been in program.") ; fun to it over and make refs

(defmacro for (var start stop &body body)
  `(loop for ,var from ,start upto ,stop
         do ,@body))

(defmacro for-adj (c &body body)
  (let ((gcol (gensym))
        (grow (gensym)))
    `(for ,gcol -1 1
          (for ,grow -1 1
               (unless (and (zerop ,gcol) (zerop ,grow))
                 (let ((adj-x (+ (cell-x ,c) ,gcol))
                       (adj-y (+ (cell-y ,c) ,grow)))
                   ,@body))))))

(defun min-x (lst) (reduce #'min lst :key #'x))
(defun min-y (lst) (reduce #'min lst :key #'y))
(defun max-x (lst) (reduce #'max lst :key #'x))
(defun max-y (lst) (reduce #'max lst :key #'y))

(defun cell-at (x y lst)
  "Fetches cell occupying (x y), or puts one there. nd"
  (dolist (cell lst)
    (when (and (= x (cell-x cell))
               (= y (cell-y cell)))
      (return-from cell-at (values cell t))))
  (values (make-cell :x x :y y) nil))

(defun num-adj (c lst)
  "Returns the number of live cells adjacent to c. nd"
  (let ((count 0))
    (for-adj c
             (let ((adj (cell-at adj-x adj-y lst)))
               (when (cell-live adj)
                 (incf count))))
    count))

(defun validate (lst)
  "Pads all the cells in lst. nd"
  (dolist (c lst lst)
    (for-adj c
             (multiple-value-bind (adj p)
                 (cell-at adj-x adj-y lst)
               (unless p
                 (push adj lst))))))

(defun turn (lst)
  "Returns a list containing next turn's extant cells. nd"
  (let ((acc nil))
    (dolist (c (validate lst) (validate acc))
      (let ((nadj (num-adj c lst)))
        (when (and (cell-live c) (or (= 2 nadj)
                                     (= 3 nadj)))
          (push c acc))
        (when (and (not (cell-live c)) (= 3 nadj))
          (push (make-cell :live t :x (cell-x c) :y (cell-y c)) acc))))))

(defun o-change (lst &optional (o (car lst)))
  "Returns a list with the coordinates of each point updated to be relative to the point o. nd"
  (let ((x-change (- (cell-x o)))
        (y-change (- (cell-y o))))
    (mapcar #'(lambda (c)
                (make-cell :live (cell-live c) :x (+ x-change (cell-x c)) :y (+ y y-change (cell-y c))))
            lst)))

ascii-display.lisp

(defpackage :ascii-display
  (:use :common-lisp :cell)
  (:nicknames :ad))
(in-package :ascii-display)

(defun rect (lst)
  "Returns the dimensions of a rectangular region containing all cells in lst. nd"
  (values (abs (- (max-x lst) (min-x lst)))
          (abs (- (max-y lst) (min-y lst)))))

(defun display (lst)
  "Prints lst to the screen. nd"
  (multiple-value-bind (x y)
      (rect lst)
    (let* ((top-left (cell-at (min-x lst) (max-y lst) lst))
           (lst (o-change lst top-left)))
      (for row 0 y
           (for col 0 x
                (let ((c (cell-at col (- row) lst)))
                  (if (cell-live c)
                      (princ "C ")
                    (princ "E "))))
           (terpri)))))

(defun cycle-input (prompt valid-inputs)
  (format t prompt)
  (let ((input (read)))
    (if (member input valid-inputs)
        input
      (progn (format t "Enter "~{~#[~;'~a'~;'~a' or '~a'~:;~@{'~a'~#[~;, or ~:;, ~]~}~]~}".~%" valid-inputs)
             (cycle-input prompt)))))

(defun cycle (lst)
  (let ((turns 0))
    (loop
     (format t
             "Conway's Game of Life : TURN ~A
------------------------------~%" turns)
     (display lst)
     (format t
             "------------------------------
'n' to continue simulation.
'q' to quit.~%")
     (let ((input (cycle-input "> " '(n q))))
       (when (eql input 'q)
         (return)))
     (incf turns))))