;
; Logic Maze Solver
; from Lisp in Small Parts, http://lisp.plasticki.com/
; Licensed under CC0 1.0: http://creativecommons.org/publicdomain/zero/1.0/
; 23rd April 2013
;

(defparameter maze 
  '(4 4 2 2 2 5
    5 1 2 3 1 2
    3 3 3 2 3 4
    2 1 2 2 3 5
    3 3 3 3 4 1
    4 3 5 2 5 0))

(defparameter start 0)
(defparameter goal 35)
(defparameter width 6)
(defparameter height 6)

(defun parse-board (board size-x size-y)
  (let (allmoves)
    (dotimes (yy size-y)
      (dotimes (xx size-x)
        (let* ((i (+ xx (* yy size-x)))
               (c (nth i board))
               (moves))
          (dolist (d '((0 -1) (0 1) (1 0) (-1 0)))
            (let* ((dx (first d))
                   (dy (second d))
                   (x (+ xx (* dx c)))
                   (y (+ yy (* dy c))))
              (when (and (< -1 x) (< x size-x) (< -1 y) (< y size-y) (> c 0))
                (setf moves (cons (+ x (* y size-x)) moves)))))
          (setf allmoves (cons moves allmoves)))))
    (reverse allmoves)))

(defparameter moves (parse-board maze width height))

(defun next-moves (state)
  (let* ((cell (first state))
         (route (second state))
         (result nil))
    (dolist (move (nth cell moves))
      (setf result (cons (list move (cons cell route)) result)))
    result))

(defun tree-search (states)
  (if (null states)
      nil
    (if (= (first (first states)) goal) 
        (reverse (cons (first (first states)) (second (first states))))
      (tree-search
       (append (rest states)
               (next-moves (first states)))))))