Maze in Lisp

Started by TomToad, October 27, 2019, 10:36:06

Previous topic - Next topic

TomToad

Here is an example of a maze generated using Common Lisp
;;;seed the random number generator
(setf *random-state* (make-random-state t))
;;;constants to hold width and height of maze
(defconstant WIDTH 20)
(defconstant HEIGHT 10)

;;; the cell structure, north, south, east, west -> t = path, nil = wall
(defstruct cell
(position '(0 0))
(north nil)
(south nil)
(east nil)
(west nil)
(visited nil))

;;; the array of cells,
(setf maze (make-array (list HEIGHT WIDTH)))

;;; this function takes a cell as input and returns a list of valid directions
;;; i.e. not across border, not visited
(defun get-valid-directions (cell)
(let ((directions nil)
(position (cell-position cell)))
(if (and (> (first position) 0) (not (cell-visited (aref maze (- (first position) 1) (second position)))))
(push 0 directions))
(if (and (< (second position) (- WIDTH 1)) (not (cell-visited (aref maze (first position) (+ (second position) 1)))))
(push 1 directions))
(if (and (< (first position) (- HEIGHT 1)) (not (cell-visited (aref maze (+ (first position) 1) (second position)))))
(push 2 directions))
(if (and (> (second position) 0) (not (cell-visited (aref maze (first position) (- (second position) 1)))))
(push 3 directions))
directions))

;;; fill the array with cells
(dotimes (column WIDTH)
(dotimes (row HEIGHT)
(setf new-cell (make-cell))
(setf (cell-position new-cell) (list row column))
(setf (aref maze row column) new-cell)))

;;; our stack for the recursive-backtracker algorythm.
(setf stack nil)

;;; pick a cell at random and place it on the stack
(setf current-cell (aref maze (random HEIGHT) (random WIDTH)))
(setf (cell-visited current-cell) t)
(push current-cell stack)
;;; repeat until the stack is empty
(do ((current-cell (first stack) (first stack)))
((null stack))
(let  ((directions (get-valid-directions current-cell))
(position (cell-position current-cell))
(direction 0)
(chosen-cell nil))
(cond ((= (length directions) 0)
(pop stack))
(t (setf direction (nth (random (length directions)) directions))
(cond ((= direction 0)
(setf chosen-cell (aref maze (- (first position) 1) (second position)))
(setf (cell-north current-cell) t)
(setf (cell-south chosen-cell) t)
(setf (cell-visited chosen-cell) t))
((= direction 1)
(setf chosen-cell (aref maze (first position) (+ (second position) 1)))
(setf (cell-east current-cell) t)
(setf (cell-west chosen-cell) t)
(setf (cell-visited chosen-cell) t))
((= direction 2)
(setf chosen-cell (aref maze (+ (first position) 1) (second position)))
(setf (cell-south current-cell) t)
(setf (cell-north chosen-cell) t)
(setf (cell-visited chosen-cell) t))
((= direction 3)
(setf chosen-cell (aref maze (first position) (- (second position) 1)))
(setf (cell-west current-cell) t)
(setf (cell-east chosen-cell) t)
(setf (cell-visited chosen-cell) t)))
(push chosen-cell stack)))))

;;;print the maze :):):):)
(format t "~&+")
(dotimes (column WIDTH)
(format t "--+"))
(dotimes (row HEIGHT)
(format t "~&|")
(dotimes (column WIDTH)
(if (equal (cell-east (aref maze row column)) t)
(format t "   ")
(format t "  |")))
(format t "~&+")
(dotimes (column WIDTH)
(if (equal (cell-south (aref maze row column)) t)
(format t "  +")
(format t "--+"))))
------------------------------------------------
8 rabbits equals 1 rabbyte.

PixelOutlaw

#1
Very nice algorithm! :D
Shame you never got your kudos!

Couple of thoughts if you don't mind. (forgive me if I'm preaching to the choir)
0. I had some errors in Steel Bank Common Lisp so I went ahead and fixed them and touched up the code a bit.
1. Make sure you define global "variables" with defparameter, defconstant if you never want to be able to change them in your session...
2. setf is not meant for declaring variables, only mutating existing ones, make sure you've got them in a let form or in one of the above.
3. You can greatly simplify the expressions by pulling more computations out of the body and up into intermediate LET and LET* (lexical) variables.
4. I've adjusted the magic numbers for directions to be Lisp symbols. Symbols are a unique thing to Lisp but they are constants that evaluate to themselves.
5. "global" symbols are usually given ear muffs so you can instantly identify them at a glance aka *my-global-foo*
6. One fun fact is setf can be used with multiple symbols and their assignments at once. I've simplified that a bit.
7. I find do a bit confusing so I show how you can use Common Lisp's notorious multi initializing multi clause loop.
Loop was implemented for the old ALGOL folks to transcribe their code.
It is hands down the most powerful loop in programming the spec is fascinating if you've got a week to tinker in it. :P

Hope you don't mind. Just some tips from a Lisp fan.

;;;seed the random number generator
(setf *random-state* (make-random-state t))
;;;parameters to hold width and height of maze

(defparameter *width* 20)
(defparameter *height* 10)

;;; the cell structure, north, south, east, west -> t = path, nil = wall
(defstruct cell
  (position '(0 0))
  (north nil)
  (south nil)
  (east nil)
  (west nil)
  (visited nil))

(defun cell-unvisited-p (cell)
  "Predicate to see if a cell is unvisited"
  (not (cell-visited cell)))

;;; the array of cells,
(defparameter *maze* (make-array (list *height* *width*)))

(defun get-cell (x y)
  "Using the global *maze* return a cell or nil if unpopulated"
  (aref *maze* x y))

;; Common Lisp has a notion of "places" for setf, we make a custom macro
;; that allows setting to the place get-cell returns
(defsetf get-cell (x y) (new-value)
  `(setf (aref *maze* ,x ,y) ,new-value))

;;; fill the array with cells
(dotimes (column *width*)
  (dotimes (row *height*)
    (setf (get-cell row column) (make-cell :position (list row column)))))

;;; this function takes a cell as input and returns a list of valid directions
;;; i.e. not across border, not visited
(defun get-valid-directions (cell)
  (let* ((directions nil)
         (position (cell-position cell))
         (row (first position))
         (col (second position)))
    (and (> row 0) ; And short circuits, last item is done only if others pass
         (cell-unvisited-p (get-cell (- row 1) col))
         (push 'NORTH directions))
    (and (< col (- *width* 1))
         (cell-unvisited-p (get-cell row (+ col 1)))
         (push 'EAST directions))
    (and (< row (- *height* 1))
         (cell-unvisited-p (get-cell (+ row 1) col))
         (push 'SOUTH directions))
    (and (> col 0)
         (cell-unvisited-p (get-cell row (- col 1)))
         (push 'WEST directions))
    directions))

;;; our *stack* for the recursive-backtracker algorythm.
(defparameter *stack* nil)

;;; pick a cell at random and place it on the *stack*
(let ((current-cell (get-cell (random *height*) (random *width*))))
  (setf (cell-visited current-cell) t)
  (push current-cell *stack*))

(defun pick-one (sequence)
  "Given a sequence, select a random element."
  (elt sequence (random (length sequence))))

;;; repeat until the *stack* is empty
(loop :for current-cell := (first *stack*) ; gobble each iteration
      :while *stack* ; any non NIL list is T in Common Lisp
      :do (let*  ((directions (get-valid-directions current-cell))
                  (position (cell-position current-cell))
                  (row (first position))
                  (col (second position))
                  (direction 0)
                  (chosen-cell nil))
            (if (zerop (length directions))
                (pop *stack*)
                (progn
                  (setf direction (pick-one directions))
                  (case direction ; dispatch on symbols, don't need quoting for CASE
                    (NORTH
                     (setf chosen-cell (get-cell (- row 1) col)
                           (cell-north current-cell) t
                           (cell-south chosen-cell) t
                           (cell-visited chosen-cell) t))
                    (EAST
                     (setf chosen-cell (get-cell row (+ col 1))
                           (cell-east current-cell) t
                           (cell-west chosen-cell) t
                           (cell-visited chosen-cell) t))
                    (SOUTH
                     (setf chosen-cell (get-cell (+ row 1) col)
                           (cell-south current-cell) t
                           (cell-north chosen-cell) t
                           (cell-visited chosen-cell) t))
                    (WEST
                     (setf chosen-cell (get-cell row (- col 1))
                           (cell-west current-cell) t
                           (cell-east chosen-cell) t
                           (cell-visited chosen-cell) t)))
                  (push chosen-cell *stack*)))))

;;;print the *maze* :):):):)
(format t "~&+")
(dotimes (column *width*)
  (format t "--+"))
(dotimes (row *height*)
  (format t "~&|")
  (dotimes (column *width*)
    (if (equal (cell-east (get-cell row column)) t)
        (format t "   ")
        (format t "  |")))
  (format t "~&+")
  (dotimes (column *width*)
    (if (equal (cell-south (get-cell row column)) t)
        (format t "  +")
        (format t "--+"))))

Seems to still work. :)

One DEFUN to rule them all, One DEFUN to find them, One DEFUN to RETURN them all, and in the darkness MULTIPLE-VALUE-BIND them.