迷路の最短ルートを探索するEmacs Lisp

元ネタ: http://okajima.air-nifty.com/b/2010/01/post-abc6.html

幅優先検索を使えば一瞬で解けるのでいちいち晒すほどのネタではありませんが、解決手順をEmacs Lispでアニメーションできたら面白いかなと思ったのでやってみました。

C-x bで適当なバッファを作って迷路を入力します。ちょっと試したいという方は以下の迷路をコピペするとよいでしょう。

**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************

次に以下の関数を評価します。後は先ほどのバッファでM-x solve-mazeすれば解決手順をアニメーションしてくれます。

(defun solve-maze ()
  (interactive)
  (save-excursion
    (loop with delay = 0.03
          with q
          with qe
          with m = (make-vector (buffer-size) nil)
          with d = '(backward-char previous-line forward-char next-line)
          with e
          initially
          (goto-char (point-max))
          (search-backward "S")
          (setq q (setq qe (list (cons 0 (point)))))
          until e
          until (read-event nil nil delay)
          while q
          for n = (caar q)
          for p = (cdar q)
          do
          (goto-char p)
          (loop until e
                for f in d
                do
                (save-excursion
                  (call-interactively f)
                  (cond
                   ((and (eq (char-after) ? )
                         (null (aref m (point))))
                    (sit-for delay)
                    (aset m (point) (1+ n))
                    (setcdr qe (list (cons (1+ n) (point))))
                    (setq qe (cdr qe)))
                   ((eq (char-after) ?G)
                    (loop until (eq n 0)
                          for p = nil
                          do
                          (loop until p
                                for f in d
                                do
                                (save-excursion
                                  (call-interactively f)
                                  (when (eq (aref m (point)) n)
                                    (setq n (1- (aref m (point)))
                                          p (point))
                                    (delete-char 1)
                                    (insert "$")
                                    (sit-for delay))))
                          (goto-char p))
                    (setq e t)))))
          (setq q (cdr q)))))