A Toy Maze Solver

;;;; -*- coding: utf-8 -*-

(defparameter *maze-image*
  (make-array '(8 8) :initial-contents
              '((1 1 1 1 1 1 1 1)
                (1 0 1 0 1 1 0 1)
                (1 0 1 0 1 0 0 1)
                (1 0 0 0 1 1 0 1)
                (1 1 1 0 0 0 0 1)
                (1 0 1 0 1 1 0 1)
                (1 0 0 0 0 1 0 1)
                (1 1 1 1 1 1 1 1))))

(defun is-passage (maze-image x y)
  (= (aref maze-image y x) 0))

(defun make-maze-map (maze-image)
  (let ((result '()))
    (loop :for y :from 1 :to 6 :do
       (loop :for x :from 1 :to 6 :do
          (when (is-passage maze-image x y)
            (let ((position (list x y nil))
                  (movable-positions '()))
              (loop :for (dx dy) :in '((0 -1) (1 0) (0 1) (-1 0)) :do
                 (when (is-passage maze-image (+ x dx) (+ y dy))
                   (push (list (+ x dx) (+ y dy)) movable-positions)))

              (push (list position movable-positions) result)))))
    (reverse result)))


(defun get-movable-positions (maze-map current-position)
    (let ((result nil))
      (dolist (candidate-position
                (cadr (assoc `(,@current-position t) maze-map :test #'equal)))
        (if (assoc `(,@candidate-position nil) maze-map :test #'equal)
            (push candidate-position result)))
      result))


(defun set-passed-mark (maze-map position)
  (setf (caddr (car (assoc `(,@position nil) maze-map :test #'equal))) t))


(let ((maze-map (make-maze-map *maze-image*)))
  (defun walk-maze (current-position goal)
    (format t "curpos : ~a~%" current-position)
    (set-passed-mark maze-map current-position)
    (if (equal current-position goal)
        (list goal)
        (let ((movable-positions (get-movable-positions maze-map current-position)))
          (format t "movable : ~a~%" movable-positions)
          (cond (movable-positions
                 (dolist (next-position movable-positions)
                   (let ((move-result (solve-maze next-position goal)))
                     (cond (move-result
                            (return (append (list current-position) move-result)))
                           (t nil)))))
                (t nil)))) ))


(defun solve-maze (start goal)
  (walk-maze start goal))