maze.lisp

(require :arnesi)
(require :cl-match)
(require :split-sequence)
(import '(arnesi:queue arnesi:enqueue arnesi:dequeue split-sequence:split-sequence))
(use-package :cl-match)
(arnesi:enable-sharp-l)

(defvar *maze-str*
"**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************")

(defvar *maze-list* (mapcar #L(coerce !1 'list) (split-sequence #\Newline *maze-str*)))

(let ((plist (loop for line in *maze-list*
		for i from 0
		append (loop for c in line
			  for j from 0
			  when (char= #\S c) return (list :start (list i j))
			  when (char= #\G c) return (list :goal  (list i j))))))
  (defvar *start* (getf plist :start))
  (defvar *goal* (getf plist :goal)))

(defconstant +dir+ '((0 -1) (-1 0) (1 0) (0 1)))

(defun calc-cost-table (start goal maze-list)
  (let ((h (make-hash-table :test 'equal))
	(q (make-instance 'queue)))
    (enqueue q start)
    (setf (gethash start h) 0)
    (loop named outer
       for curxy = (dequeue q)
       do (loop for (dx dy) in +dir+
	     do (let ((x (+ dx (car curxy)))
		      (y (+ dy (cadr curxy))))
		  (when (and (or (char= #\Space #1=(elt (elt maze-list x) y))
				 (char= #\G #1#))
			     (letmatch (vals _ b) (gethash (list x y) h) (not b)))
		    (enqueue q (list x y))
		    (setf (gethash (list x y) h) (1+ (gethash curxy h)))
		    (when (equal goal (list x y)) (return-from outer h)))))
       finally (return-from outer h))))

(defvar *cost-table* (calc-cost-table *start* *goal* *maze-list*))

(defun find-route (start goal cost-table)
  (loop named outer
     with cur = goal with acc = ()
     until (equal cur start)
     do (letmatch (vals cost1 _) (gethash cur cost-table)
	  (loop named inner for (dx dy) in +dir+
	     do (letmatch (vals cost2 is-visit2) (gethash #1=(list (+ dx (car cur)) (+ dy (cadr cur))) *cost-table*)
		  (when (and is-visit2 (= cost1 (1+ cost2)))
		    (setf cur #1#)
		    (when (equal cur start) (return-from outer acc))
		    (push cur acc)
		    (return-from inner)))))))

(defvar *route* (find-route *start* *goal* *cost-table*))

(defun print-result (maze-list route)
  (loop for line in maze-list
     for i from 0
     do (loop for c in line
	   for j from 0
	   do (if (member (list i j) route :test 'equal)
		  (format t "~a" #\$)
		  (format t "~a" (elt (elt maze-list i) j))))
     do (format t "~%")))

(print-result *maze-list* *route*)