(defn filter-keys [pred m]
(select-keys m (filter pred (keys m))))
(defn empty-graph [] {:vertices #{} :edges {}})
(defn add-vertex [g v]
(update g :vertices #(conj % v)))
(defn add-edge [g from to label]
(-> g
(update :edges #(assoc % [from to] label))
(add-vertex from)
(add-vertex to)))
(defn get-vertices [g]
(g :vertices))
(defn get-edges [g]
(let [edges (g :edges)]
(map (fn [[from to :as e]]
[from to (edges e)])
(keys edges))))
(defn remove-vertex [g v]
(let [edges (g :edges)]
(-> g
(update :vertices #(disj % v))
(update :edges
#(filter-keys
(fn [[from to]]
(and (not= from v) (not= to v)))
%)))))
(defn remove-edge [g from to]
(update :edges #(filter-keys
(fn [e] (not= e [from to]))
%)))
(defn fmin [f s]
(reduce #(if (< (f %1) (f %2)) %1 %2) s))
(defn dijkstra
"start = starting vertex
target = targeting vertex
sv = a seq of vertices
(me v) = seq of vertices that is adjunct to v
(fw [v1 v2]) = function that gives weight v1-<v2, expecting 'nil' rep not connected"
[start target sv me fw]
(loop [S #{}
Q (set sv)
d {start {:dist 0 :path [start]}}]
(if (seq Q)
(let [u (fmin #((or (d %) {:dist js/Infinity}) :dist) Q)
upath ((d u) :path)]
(recur (conj S u) (disj Q u)
(reduce #(let [new-d (+ ((d u) :dist)
(fw [u %2]))]
(if (< new-d ((or (d %2) {:dist js/Infinity}) :dist))
(assoc %1 %2
{:dist new-d
:path (conj upath %2)})
%1))
d (me u))))
((or (d target) {:path nil}) :path))))
(defn uf-new [s]
(reduce #(assoc %1 %2 %2) {} s))
(defn uf-find [uf e]
(if (not= (uf e) e)
(let [[uf1 c] (uf-find uf (uf e))]
[(assoc uf1 e c) c])
[uf e]))
(defn uf-union [uf e1 e2]
(let [[uf1 c1] (uf-find uf e1)
[uf2 c2] (uf-find uf1 e2)]
(assoc uf2 c1 c2)))
(defn uf-same-set? [uf e1 e2]
(let [[uf1 c1] (uf-find uf e1)
[uf2 c2] (uf-find uf1 e2)]
[uf (= c1 c2)]))
(defn kruskal
[seqv seqe]
(-> (reduce #(let [[acc uf] %1
[from to weight :as e] %2
[uf1 ft-same-set] (uf-same-set? uf from to)]
(if (not ft-same-set)
[(conj acc e) (uf-union uf1 from to)]
%1))
[[] (uf-new seqv)]
(sort-by #(nth % 2) seqe))
first))
(defn shortest-path [g fweight from to]
(let [g1 (reduce (fn [acc [f t l]] (add-edge acc t f l))
g (get-edges g))]
(dijkstra
from to
(get-vertices g1)
(reduce (fn [acc [f t]]
(update acc f #(conj % t)))
{}
(keys (g1 :edges)))
(g1 :edges))
))
(defn minimal-spanning-tree [g fweight]
(let [edges (kruskal (get-vertices g)
#_(get-edges g)
(map
(fn [[f t l]] [f t (fweight l)])
(get-edges g)))]
(reduce
(fn [acc [f t w]] (add-edge acc f t w))
(reduce #(add-vertex %1 %2) (empty-graph) (mapcat (fn [[f t _]] [f t]) edges))
edges)))
NUPSC 2018 の競技問題に対し、以下の補足説明を行ないます。
問題文中では、 m
は平面上の地図を表わすとありましたが、
その地図の座標は [0 0] から始まり、[(- (m :width) 1) (- (m :height)) 1] まで終ります。
又座標は全て整数とします。
完成されていた道路交通網は必ず全ての都市を繋がっていなければならない。 又、完成されたプログラムの優劣の評価は、プロジェクト1の紹介文からでも分かるように、 道路交通網全長が短いほうが優れています。
文中に「ビットマップ」という言葉を使っていましたが、 それは単純に
{[0 0] :a, [0 1] :b,
[1 0] :c, [1 1] :d}
のようなマップを意味しています。
問題文の 「又出力のグラフの辺のウェイトはその道路の長さでなければならない。」 という部分を 「又出力のグラフの辺のラベルはその道路の長さでなければならない。」 として訂正します。
関数 city-navigation
に渡された引数 g
は連結グラフ、つまり全ての頂点から他の任意の頂点までたどりつくことができるようなグラフです。
問題文中に「マンハッタン距離」の説明が抜けていました。 平面上二点 \( (x_1, y_1) \) 、 \( (x_2, y_2) \)の間のマンハッタン距離とは両点のx座標の差とy座標の差の和、 つまり \( | x_1 - x_2 | + | y_1 - y_2 | \) となります。
m
の一例として以下が挙げられます。
{[0 0] :a, [0 1] :void,
[1 0] :void, [1 1] :c
:width 2, :height 2}
タスク2cにおけるコマンド :move-city
はタスク2bにおけるものと同じであり、
つまり [:move-city 猫の名前 移動先]
における 移動先
は 移動先の都市名 を意味するものです。
問題文から一義的に読みとることができますが、
合計移動距離は cmds
のみによって計上される移動距離を指します。
回答テンプレートは以下のものであったほうがより適切です。
(defn track-moving [cities cmds cat]
{:pos [0 0] :moved 0})