(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)))
遠い遠いところに「ネコ星」という惑星があります。 その惑星の地上を治めているのは猫という生物でした。 その生物は高度な知能を持っていますが、 常に怠惰を美徳としています。
ネコ星には様々な国もあります。 その中に「ニャポン国」という国がありました。 ニャポン国はネコ星の中一番新参の国でした。 但しその住民たちはそれはそれは聡明なネコ星の住民よりも又一段と賢く、 特に土木技術に長けていました。
ニャポン国の国民達は土木技術に長けているのは実はわけがあります。 それはニャポン国は一年ごと全ての都市を取り壊し、 全く違う場所で新しい都市を作る慣習があるからです。 我々には理解しがたい慣習ではありますが、 ニャポン国建国の父らが言わく「猫たるものは己の知性を生かし、これを誇るべし」と。 ニャポン国の大統領は都市の再建は建国の父らのその教えの表しだと宣言しています。 どうやら財産と労力をひたすら無駄に使う猫たちの国のようです。 それはそれも仕方ありません。 何故なら財産と労力を意味のあるところに使うのであれば、 それは怠惰ではありません。 ネコ星の猫たちはあくまでも怠惰を美徳としていますから。
さて、何の事由があったかは知りませんが、 君は何故かそのニャポン国の技術顧問に雇われてしまいました。 君に振られた仕事はニャポン国その壮大な都市再建計画のスマート化です。 勿論スマート化とは情報技術を使い、従来の仕事を効率良くすることです。 我々の地球と同じく、「スマート」という単語はネコ星でもバズワードだそうです。
ニャパン国の都市の場所は毎年変っていますので毎年新しい道路交通網も再建しないといけないわけになります。 ニャパン国の猫たちは聡明ではありますが、 あくまでも怠惰を美徳としています。 ですので一メートルたりとも無駄に道路を作りたくない。 君はそんなニャパン国のために始めてしてあげる仕事は、 道路交通網を設計するプログラムを組むことにしました。 又道路交通網を設計するついでに、 ナビシステムも組むことにしました。
以下のプログラムを修正し、
地図にある全ての都市の名前を枚挙する関数 list-cities を完成させなさい。
但しその関数の引数 m は以下の形式のビットマップを取り、
出力(つまり関数の返り値)は都市名のシーケンスでなければならない。
この関数を正しく完成させた者は100点を得ます。
m は平面上の地図を表わします。
(m :width) はその地図の幅、
(m :height) はその地図の長さを表わしています。
それぞれの点 (x, y) では (m [x y]) はその点にある都市名を表します。
但し :void は都市名ではなく、
空地を意味しています。
例えばサンプル入力では (m [2 1]) は :nyagoya となっていまして、
(m [2 2]) は :void になっています。
それぞれ (2, 1) に「nyagoya」という都市があることと、
(2, 2) に都市が存在しないことを表わしています。
(defn list-cities [m] [])
以下のプログラムを修正し、
道路交通網の設計関数 plan-road-system を完成させなさい。
但しその関数の引数 m はタスク1aと同じような地図を表わすビットマップを取り、
出力(つまり関数の返り値)は都市名を頂点、道路を辺として持つグラフでなければならない。
又出力のグラフの辺のウェイトはその道路の長さでなければならない。
長さは都市の位置から割り出すユークリッド距離でなければならない。
例えば (1, 7) にある都市と (9, 4) にある都市とを繋ぐ道路の長さは \( \sqrt{(1-7)^2 + (9-4)^2} \) である。
この関数を正しく完成させた者は50点を得ます。
又完成させた plan-road-system が設計した道路交通網の全長を用いてプログラムの優劣を評価し、
最も優れたプログラムを完成させた者は追加で50点を得ます。
その他この関数を正しく完成させた者は優劣順位に従い、追加で1-49点を得ます。
(defn plan-road-system [m]
(empty-graph))
以下のプログラムを修正し、
都市から都市まで移動できる経路を計算する関数 city-navigation を完成させなさい。
但しその関数の引数 g はタスク1bの出力と同じようなグラフ、
引数 from と引数 to はそれぞれ出発地の都市名と目的地の都市名を取り、
出力(つまり関数の返り値)は出発地と目的地を含む経過する都市の都市名のシーケンスでなければならない。
この関数を正しく完成させた者は50点を得ます。
又完成させた city-navigation が割り出した経路の長さを用いてプログラムの優劣を評価し、
最も優れたプログラムを完成させた者は追加で50点を得ます。
その他この関数を正しく完成させた者は優劣順位に従い、追加で1-49点を得ます。
(defn city-navigation [g from to]
(empty-graph))
ニャパン国の都市や道路交通網は毎年変っていますので、 その住民は自分の居場所を正確に把握して友達や家族に伝えるのはとても難しいようです。 この状況を改善するために君は自動的に住民たちの居場所をトラッキングするシステムを作ることにしました。
注：タスク2aに進む前タスク2sの得点説明をまず読むことをおすすめします。
トラッキングするための状態空間を猫の名前から猫の位置に写すマップとする。
例えば {:taro [2 4], :haru [3 2]} をもって、
:taro が (2, 4) の位置にいて、
:haro は (3, 2) の位置にいる状態を表すことにする。
以下のプログラムを修正し、
[:move 猫の名前 移動先]
の形のコマンドを引数 cmd で受け取り、
対応する状態遷移関数を返す関数 compile-move を完成させなさい。
この関数を正しく完成させた者は20点を得ます。
(defn compile-move [cmd]
(fn [prev] prev))
以下のプログラムを修正し、
{:nyagoya [2 4], :myae [4 7]} のように
都市名から位置に写すマップ cities と、
[:move-city 猫の名前 移動先の都市名]
の形のコマンドを引数 cmd で受け取り、、
対応する状態遷移関数を返す関数 compile-move-city を完成させなさい。
(defn compile-move-city [cities cmd]
(fn [prev] prev))
この関数を正しく完成させた者は40点を得ます。
猫たちの健康管理のため、 君は猫たちの移動距離も同じシステムでトラッキングすることにしました。
従ってトラッキングするための状態空間を少し拡張して、
猫の名前から、猫の位置と猫が移動した距離を記録したマップに写すマップとする。
例えば {:taro {:pos [2 4], :moved 10}, :haru {:pos [3 2], :moved 20}} をもって、
:taro が (2, 4) の位置にいて、合計10メートルを移動したことがあり、
:haro は (3, 2) の位置にいて、合計20メートルを移動したことがあるという状態を表すことにする。
以下のプログラムを修正し、
{:nyagoya [2 4], :myae [4 7]} のように
都市名から位置に写すマップ cities と、
[:move 猫の名前 移動先] か
[:move-city 猫の名前 移動先]
の形のコマンドを引数 cmd で受け取り、
対応する状態遷移関数を返す関数 compile-moving を完成させなさい。
但し移動距離の計算は都市のある位置からと都市のある位置に移動した場合ユークリッド距離で計上し、 そうでない場合(出発地か目的地のいずれが荒野)マンハッタン距離で計上しなければならない。
この関数を正しく完成させた者は60点を得ます。
(defn compile-moving [cities cmd]
(fn [prev] prev))
以下のプログラムを修正し、
猫たちの移動をトラッキングする関数 track-moving を完成させなさい。
但し引数 cities を {:nyagoya [2 4], :myae [4 7]} のように
都市名から位置に写すマップ、
引数 cmds を [:move 猫の名前 移動先] か
[:move-city 猫の名前 移動先]
の形のコマンドのシーケンス、
引数 cat を結果を問う猫の名前とする。
関数 track-moving は cmds のような動きが記録された後、
猫 cat の最終位置と合計移動距離を {:pos 最終位置, :moved 合計移動距離} のようなマップで返さなければならない。
又全ての猫の最初位置は (0, 0) とすし、移動距離の計算は都市のある位置からと都市のある位置に移動した場合ユークリッド距離で計上し、
そうでない場合(出発地か目的地のいずれが荒野)マンハッタン距離で計上しなければならない。
(defn track-moving [cities cmds cat] {:pos [0 0] :moved 0})
この関数を正しく完成させた者は200点を得ます。
但し、タスク2sにおける得点がタスク2a-2cにおける得点より多い場合、 タスク2a-2cの得点は 無効 となり、 タスク2sの得点のみを評価します。 逆にタスク2sにおける得点がタスク2a-2cにおける得点より少い場合、 タスク2sの得点は無効となります。