maze.lisp

; https://github.com/netb258/clj-maze/blob/master/src/maze/core.clj

; CL version, by Rainer Joswig, joswig@lisp.de, 2019


; changes
;   maze is a 2d array, contents are symbols/numbers
;   pass directions as symbols
;   use paths as position histories

(defvar *maze*)

; Maze is a 2d array. x= wall, 0=space, *=start.

(defun read-maze (file)
  (with-open-file (stream file)
    (setf *maze* (read stream))))

(defun get-start-position (maze)
  "Returns the start position as two values."
  (dotimes (i (array-dimension maze 0))
    (dotimes (j (array-dimension maze 1))
      (when (eql '* (aref maze i j))
        (return-from get-start-position (values i j))))))

(defun found-exit-p (maze i j)
  "is i j an exit?"
  (or (= 0 i) (= (1- (array-dimension maze 0)) i)
      (= 0 j) (= (1- (array-dimension maze 1)) j)))

;;; ================================================================
;;; check movement

(defun can-go-p (maze i j path)
  "Can we more to i j?"
  (and (not (member (cons i j) path :test #'equal))
       (eql '0 (aref maze i j))))

(defun can-go-dir-p (maze dir i j path)
  "can we go in direction dir from i j?"
  (case dir
    (right (and (< j (1- (array-dimension maze 1)))
                (can-go-p maze i (1+ j) path)))
    (up    (and (> i 0)
                (can-go-p maze (1- i) j path)))
    (left  (and (> j 0)
                (can-go-p maze i (1- j) path)))
    (down  (and (< i (1- (array-dimension maze 0)))
                (can-go-p maze (1+ i) j path)))))

;;; ================================================================
;;; movement

(defun go-dir (maze dir i j path)
  "try to go into direction dir from i j"
  (when (can-go-dir-p maze dir i j path)
    (case dir
      (right (walk-maze maze i      (1+ j) (cons (cons i j) path)))
      (up    (walk-maze maze (1- i) j      (cons (cons i j) path)))
      (left  (walk-maze maze i      (1- j) (cons (cons i j) path)))
      (down  (walk-maze maze (1+ i) j      (cons (cons i j) path))))))

;;; ================================================================
;;; compute paths through maze

(defun walk-maze (maze i j &optional path)
  "find all paths from i j"
  (if (found-exit-p maze i j)
      (list (cons (cons i j) path))
    (append (go-dir maze 'right i j path)
            (go-dir maze 'up    i j path)
            (go-dir maze 'left  i j path)
            (go-dir maze 'down  i j path))))

(defun maze (&optional (maze *maze*))
  (multiple-value-bind (i j)
      (get-start-position maze)
    (let* ((paths (walk-maze maze i j))
           (sorted-paths (mapcar #'reverse
                                 (sort paths #'< :key #'length))))
      (format t "~%The maze has ~a paths." (length sorted-paths))
      (format t "~%The shortest path in the maze is ~a steps long." (length (first sorted-paths)))
      (format t "~%The path is  ~a." (first sorted-paths))
      (format t "~%The longest path in the maze is ~a steps long."  (length (first (last sorted-paths))))
      (format t "~%The path is  ~a." (first (last sorted-paths))))))

;;; ================================================================
;;; Example

(defun example-maze ()
  (setf *maze*
        #2a((x x x x x x)
            (0 x 0 0 0 x)
            (x * 0 x 0 x)
            (x x x x 0 0)
            (0 0 0 0 0 x)
            (x x x x 0 x)))
  (maze *maze*))