ダイクストラ法, 与えられたグラフにおいて, ある頂点からそれ以外の各頂点への最短のパス(ルート)を求めるアルゴリズムの一つです.
- グラフの頂点を, 到達済み頂点のグループと, 未到達頂点のグループへ分割します. 到達済み頂点のグループの初期値は, 開始頂点1つからなるグループで, 未到達の頂点グループの初期値は, それ以外の頂点すべてを含んだグループになります.
- 「到達済み頂点のグループのうち, どれかの頂点」(=vn)との間に「最も短い辺を持つ未到達の頂点」(=vm)を到達済み頂点のグループへ追加する. また, この辺を新しいルートとする. (開始点から新しく追加されたvmまでのパスは, 「開始点～vnまでのパス + 新しく追加された辺」となります.)
- 未到達頂点のグループに要素がなければアルゴリズム終了. 未到達頂点のグループに要素があれば, 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 件のコメント :
コメントを投稿