(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)))
ClojureScript では def があることは以前紹介しました。
しかし実際 def は基本的に「グローバル」な名前を作ることにしか使われません。
グローバルな名前というのは全てのコードの箇所(勿論 def が使われた後でしか効力ありませんが)で使える名前です。
ClojureScript ではその「ローカル」バージョンも用意されています。
それは let というものです。
まずは例をみてみましょう
(let [x 10
y 20]
(+ x y))
このプログラムのでは、xとyは let の式の中でしか10と20の名前になっていません。
一般的に let はこのように使われています。
ちなみに 名前1などが使われている計算式 はしばしば「ボディー」とも呼ばれています。
(let [名前1 値1
名前2 値2
...]
名前1などが使われている計算式)
以下のコードブロックにある関数 dist を let を用いて書き換えよ。
完成させたコードブロックには (defn dist [a b] ..) 以外の
def や defn はあってはいけない。
又 ; で始まる行は ClojureScript では「コメント」と呼ばれていて、
プログラムを実行するとき無視されます。
(def sq (fn [x] (* x x)))
; a, b は [1 3] のような二つの要素のあるシーケンスをもって表わされた二次元の座標である。
(defn dist [a b]
(Math/sqrt
(* (sq (- (first a) (first b)))
(sq (- (first (rest a)) (first (rest b)))))))
以前ベクターに対して (get vector index) が紹介されていましたが、
get は実はベクターにだけ使用することができ、
一般的なシーケンスには使用できません。
一般的なシーケンスに get を使いたい場合、
(nth sequence index) を使えばよい。
但し、nthはベクターにも使いますが、 index が大きい場合、
nth は get より大分遅い。
演習5.1aにある (first (rest ??)) の部分を nth で書き変えなさい。
ClojureScript では例えば二次元座標を二要素のベクター・シーケンスで表すことがしばしばありますので、 その中身を便利に取りだす機能が実はあります。 以下の例をみてみましょう。
(def a [1 3])
(def b [2 4])
(let [[x1_ y1_] a]
(def x1 x1_)
(def y1 y1_))
(def c (let [[x1 y1] a
[x2 y2] b]
[(+ x1 x2) (y1 y2)]))
[x1 y1 c]
この機能は「構造破壊 (destructuring)」と呼ばれています。
ClojureScript では構造破壊は基本的に新しい名前を導入する全ての場所で使えます。
例えば関数の引数の宣言や loop 構文の変数の宣言のところも使えます。
一例をみましょう。
(def a [1 3])
(def b [2 4])
(defn add [[x1 y1] [x2 y2]]
[(+ x1 x2) (+ y1 y2)])
(add a b)
構造破壊機能を使い、以下のコードブロックで平面上両点の距離を求める関数 dist を完成せよ。
(defn dist [a b] 0)
又補足としてこの構造破壊機能はシーケンスだけではなく、 マップに対しても使えます。 例えば
(def person {:name :alice
:age 13
:hobby :classical-music})
(let [{nm :name
ag :age
hb :hobby} person]
[nm :aged ag :likes hb])
そして「破壊式」の最後に :as 全体の名前 を付け加えば破壊している値全体にも名前を付けることができる。
(注: 「破壊式」は一般的な呼びかたではなく、単に便利上ここでそう呼んでいるだけである)
例えば
(def person {:name :alice
:age 13
:hobby :classical-music})
(let [{nm :name
:as pn} person]
[:we :have :a :person :named nm :and :it :is pn])
(def a [3 2])
(let [[x y :as pt] a]
[:point pt :has :x-pos :of x :and :y-pos :of y])
又 ClojureScript では for という便利なものがあります。
これは計算機科学では一般的に「リスト内包表記」と呼ばれるものであり、
ClojureScript ではシーケンスを作ることができます。
まずは例をみましょう
(def xs (range 10))
(def ys (range 7))
(for [x xs
y ys]
[x y])
for は let などと似たような名前の宣言の部分がありますが、
for の場合単純に値に名前を付けるのではなく、
例えば (for [x [1 2 3]] (+ x 1)) の場合、
[1 2 3] の要素を一つずつ取り出し、
x と名付けて (+ x 1) という演算をします。
そして全ての演算結果をシーケンスで返します。
for で複数の名前・シーケンスのペアを指定するとき、
名前上のコードブロックの例にあるように、
全ての取り出しかたが枚挙され、その演算結果はシーケンスで返されます。
そして for では :when を用いて演算を行う条件を指定することもできます。
例えばこのように (= x y) を除外した全て(0, 0)から(9, 9)の点を枚挙することができます。
(def xs (range 10))
(def ys (range 10))
(for [x xs
y ys :when (not (= x y))]
[x y])
for と構造破壊を用いて演習4.2dを以下のコードブロックで書き直せ。
(defn shortest-path-length [g from to]
(empty-graph))
Chapter 3では我々は状態遷移関数についてみてきました。 但しChapter 3では我々が扱ったのは固定されているような状態遷移関数ばかりでした。 単一の固定された状態遷移関数でもいろいろな現実問題の数理モデルになり得ますが、 より多い現実問題では変動する条件にしたがい、状態遷移関数を調整する必要がしばしばあります。 その時その変動する条件を「コマンド」だと考えてそれぞれのコマンドに対応している状態遷移関数を生成する関数を用意すれば対応できます。
また時計を例として使いましょう。
今度は我々は秒針の状態だけではなく、
分針と秒針両方扱うことにしよう。
となりますと、状態は{:min 7 :sec 10}のようなマップとして扱うのが適切であろう。
ClojureScript ではベクターはコマンドを表すにふさわしい。
我々の時計シミュレーションシステムでは例えばコマンドとして対応するのは
[:advance-sec 秒針が進む秒数] [:advace-min 分針が進む分数]
のようなものとしましょう。
以下のプログラムを完成させ、
compile-watch-cmd
を上記のようなコマンドを対応している状態遷移関数に変換する関数にせよ。
但し秒針と分針の目盛は０～５９とする。
(defn compile-watch-cmd [cmd]
(fn [prev] prev))
通常コマンドは単発ではなく、
複数のコマンドを連続的に処理しないといけない。
以下のプログラムを完成させ、
compile-watch-cmds
を演習5.2aにあるようなコマンドのシーケンスcmdsと初期状態prevを受け取り、
cmdsの全てのコマンドがprevに実行された最終状態を返す関数にせよ。
(defn compile-watch-cmds [cmd prev]
prev)