; ; 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)))))))
blog comments powered by Disqus