2014/12/26

Clojureでダイクストラ法


 ダイクストラ法, 与えられたグラフにおいて, ある頂点からそれ以外の各頂点への最短のパス(ルート)を求めるアルゴリズムの一つです.

  1. グラフの頂点を, 到達済み頂点のグループと, 未到達頂点のグループへ分割します. 到達済み頂点のグループの初期値は, 開始頂点1つからなるグループで, 未到達の頂点グループの初期値は, それ以外の頂点すべてを含んだグループになります.
  2. 「到達済み頂点のグループのうち, どれかの頂点」(=vn)との間に「最も短い辺を持つ未到達の頂点」(=vm)を到達済み頂点のグループへ追加する. また, この辺を新しいルートとする. (開始点から新しく追加されたvmまでのパスは, 「開始点~vnまでのパス + 新しく追加された辺」となります.)
  3. 未到達頂点のグループに要素がなければアルゴリズム終了. 未到達頂点のグループに要素があれば, 2へ.

 日本語で書くとこんな感じで, 未到達の頂点が1つづつ減っていって, すべての頂点へのルートが決定します.

 なんとなく階層的クラスタリングに似ている気もしますが. 以下のような感じでダイクストラ法の実行結果が得られます. a~jがグラフ中の各点で隣の数字が開始点からの最短距離で, 赤線が開始点からの各点へのルートを表します. 黒線は, グラフに含まれているが, 最短ルートには含まれない辺. 例えば, c→jのルートは, c → d → a → j となります.

 以下の図において, 各点は, (x,y)座標が与えられており, 各点間の距離(=辺の長さ)は二乗距離で定義されます. (つまり, 視覚的な距離と, 頂点間の距離(辺の長さ)がおおよそ対応しています.)
 ナイーブなダイクストラ法の実装が以下のコードです. ダイクストラ法本体の実装より, グラフと実行結果可視化のコードの方がなぜか, 分量が多いですが.
(use '[clojure.core.match :only (match)]
     '[clojure.math.numeric-tower :as math])

;;---------------------------------------------------------------
;; find path

(defn mean-square [x1 x2 y1 y2]
  (math/sqrt (+ (* (- x1 x2) (- x1 x2)) (* (- y1 y2) (- y1 y2)))))

(defn get-weights [routes points-with-coord]
  (defn get-distance
    [point-A point-B]
    (let [a (get points-with-coord point-A)
          b (get points-with-coord point-B)]
      (mean-square (first a) (first b) (second a) (second b))))
  (->> routes
       (map #(get-distance (first %) (second %)))
       (interleave routes)
       (apply hash-map)))

(defn get-neighbors [routes]
  (->> (concat (map reverse routes) routes)
       (map vec)
       sort
       (group-by first)
       (map (fn [x] (list (first x) (map second (second x)))))
       (reduce concat)
       (apply hash-map)))

(defn find-path [start routes vs weights]

  (defn length [u v]
    (weights (sort (list u v))))

  (defn get-dist [x dp]
    (get-in dp [x :dist]))

  (defn find-nearest [xs dp]
    (->> (map (fn [x] [(get-dist x dp) x]) xs)
         sort first second))

  (defn short-route? [u v dp]
    (< (+ (length u v) (get-dist u dp)) (get-dist v dp)))

  (defn set-shorter [u v dp]
    (assoc-in dp [v] {:dist (+ (get-dist u dp) (length u v)) :prev u}))

  (defn update-at [u dp v]
    (if (short-route? u v dp) (set-shorter u v dp) dp))

  (let [distance-previous-data
        (->> vs
             (map #(list % {:dist Double/POSITIVE_INFINITY :prev nil}))
             (apply concat) (apply hash-map)
             (#(assoc-in % [start] {:dist 0 :prev nil})))]
   (loop [q vs dp distance-previous-data]
      (if (empty? q)
        dp
        (let [u (find-nearest q dp)
              new (reduce (partial update-at u) dp (u (get-neighbors routes)))]
          (recur (remove #(= u %) q) new))))))

;;---------------------------------------------------------------
(def spwc ;;sample-points-with-coord
  {:a [20 80] :b [35 20] :c [80 40] :d [60 100] :e [70 10]
   :f [10 60] :g [120 80] :h [20 35] :i [110 20] :j [0 120]})

(def sample-routes
  (let [routes
        [[:j :f] [:j :a] [:f :a] [:f :h]
         [:a :d] [:d :g] [:g :c] [:c :d]
         [:g :i] [:c :i] [:c :e] [:e :i]
         [:a :h] [:h :b] [:b :e] [:b :c]]]
    (map sort routes)))

;; samples
;; (find-path :j sample-routes (keys spwc) (get-weights sample-routes spwc))
;; (find-path :c sample-routes (keys spwc) (get-weights sample-routes spwc))

;;---------------------------------------------------------------
;; graph plot

(import (javax.swing JFrame))
(import (java.awt Color))
(import (java.awt Graphics))
(import (java.awt Graphics2D))
(import (java.awt Font))

(def radius 8)

(defn x-extend [x]
  (+ (* (- x radius) 3) 50))

(defn y-extend [y]
  (+ (- (* (- y radius) 3)) 400))

(defn vertex->str [key]
  (apply str (rest (str key))))

;; (plot-graph spwc sample-routes)
(defn plot-graph [points route-pairs answer]
  (let [window-size 450
        font  (Font.  "Monospace" Font/BOLD 14)
        frame (JFrame. "Route")
        get-x #(+ radius (x-extend (first %1)))   ;; for draw-line
        get-y #(+ radius (y-extend (second %1)))] ;; for draw-line

    (doto frame
      (.setSize window-size window-size)
      (.setVisible true)
      (.setResizable false))
    (Thread/sleep 100) ;; wait for the generateion of Window

    (def graphics (.. frame (getGraphics)))

    (defn plot-point [name]
      (let [coord (name points)
            r (* radius 2)
            x-pos (x-extend (first  coord))
            y-pos (y-extend (second coord))]

        (doto (cast Graphics2D graphics)
          (.setColor (Color. 255 100 100))
          (.fillOval x-pos y-pos r r)
          (.setColor (Color. 100 190 190))
          (.drawOval x-pos y-pos r r)
          (.setColor Color/blue)
          (.setFont font)
          (.drawString
           (->> answer name :dist round (str (vertex->str name) "="))
           (+ x-pos 20) (+ y-pos 10)))))

    (defn draw-line [point-a point-b]
      (let [a (point-a points) b (point-b points)]
        (if (or (= point-b (:prev (point-a answer)))  ;; from b to a
                (= point-a (:prev (point-b answer)))) ;; from a to b
          (.setColor graphics Color/red)
          (.setColor graphics Color/black))
        (.drawLine graphics (get-x a) (get-y a) (get-x b) (get-y b))))

    ;; draw background
    (doto graphics
      (.setColor Color/white)
      (.fillRect 0 0 window-size window-size))

    ;; draw route
    (doall (map draw-line (map first route-pairs) (map second route-pairs)))

    ;; draw points
    (doall (map plot-point (keys points)))

    (println "done!")))

;;---------------------------------------------------------------
;; execution example
(def from-a (find-path :a sample-routes (keys spwc) (get-weights sample-routes spwc)))
(def from-c (find-path :c sample-routes (keys spwc) (get-weights sample-routes spwc)))
(def from-e (find-path :e sample-routes (keys spwc) (get-weights sample-routes spwc)))
 こんな感じになりました. find-path関数で, 最短ルートとその距離を求めます. find-pathの一番目の引数は, 開始点. get-weights関数は, 各辺の重み(=距離)を計算しています. plot-graphでSwingにより, グラフを表示します.

 以下のように実行します.
user> (load-file "find-path.clj")
#'user/from-e
user> (plot-graph spwc sample-routes from-e)
done!
nil
user> (plot-graph spwc sample-routes from-a)
done!
nil
というわけで実行結果. 開始点をaとすると,
となり, 開始点をeとすると,

こんな感じ.

0 件のコメント :