迷路を最短経路で解く問題を Clojure で

Clojure といえば、巷ではProgramming Clojureの日本語訳である「プログラミング Clojure」の献本が行われているようで、これが発売すればいよいよ日本でも本格的に Clojure が広まっていくんじゃないでしょうか。

というわけで、スタートダッシュ(というかフライング？)を決めるために今のうちに Clojure について書いておこうと思います。お題については、もうちょっと流行には乗り遅れた感があるけど、迷路を最短経路で解く例の問題です。

解き方は至ってシンプルな幅優先探索です。せっかくなのでマルチスレッド化しようかと思ったんですが、それなりの時間で解けているようなので今回は放置。

実行例

$ cat maze.txt
**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************

$ time clj maze.clj maze.txt
**************************
*S* * $$$$               *
*$* *$$* $*************  *
*$* $$*  $$************  *
*$$$$*    $$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$$$* $$$$$$$$$$$$$G  *
*  *  $$$$*********** *  *
*    *        ******* *  *
*       *                *
**************************
clj maze.clj maze.txt  1.65s user 0.10s system 86% cpu 2.035 total
$

ソースコード

(use '[clojure.contrib.duck-streams :only (read-lines)])

(defn value-at [maze y x]
  ((maze y) x))

(defn nrows [maze]
  (count maze))

(defn ncols [maze]
  (count (maze 0)))

(defn neighbors [maze [y x]]
  (for [[dy dx] [[0 1] [1 0] [0 -1] [-1 0]]
	:let [y (+ y dy), x (+ x dx)]
	:when (not= \* (value-at maze y x))]
    [y x]))

(defn solve
  ([maze candidate] (solve maze [[candidate]] #{}))
  ([maze candidates visited]
   (let [[[y x :as pos] :as paths] (candidates 0)]
     (cond (nil? pos) nil
           (= (value-at maze y x) \G) (reverse paths)
           :else
	   (let [cands (map #(cons % paths)
			    (remove visited (neighbors maze pos)))]
	     (recur maze
		    (into (subvec candidates 1) cands)
		    (conj visited pos)))))))

(defn search-start [maze]
  (first (for [y (range (nrows maze)), x (range (ncols maze))
	       :when (= \S (value-at maze y x))]
	   [y x])))

(defn print-solution [maze paths]
  (let [ncols (ncols maze), path? (apply hash-set paths)]
    (doseq [y (range (nrows maze)), x (range ncols)
	    :let [v (value-at maze y x)]]
      (if (and (path? [y x]) (not (#{\S \G} v)))
	(print \$)
	(print v))
      (when (= x (dec ncols)) (newline)))))

(defn main [filename]
  (let [maze (vec (map vec (read-lines filename)))]
    (print-solution maze (solve maze (search-start maze)))
    (flush)))

(main (first *command-line-args*))