Chapter 4 (NUPSC 2018 講習資料)

(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)))
      

§4.1. マップとキーワード

今まで我々は数をもっぱら扱ってきましたが、 勿論コンピューターでは数以外のデーターも扱うことができます。 ClojureScript もその例外ではない。 ClojureScript では数以外に「キーワード (keyword)」という種類のデータもあります。 例えば :cat は「cat」という名前を持つキーワードです。

キーワードに対して我々ができる(ほぼ唯一な)ことは二つのキーワードが等しいかどうかを比較することです。 例えば

            [(= :cat :cat) (= :cat dog)]
        

比較しかできないものが何の役に立つのか？と思うかも知れませんが、 実はそのようなものは物事の名前として使うのは最適です。

ClojureScript でキーワードとの繋がりと割と深いものとしては「マップ (map)」というものがあります。 ここで注意しないといけないのはややこしいにここでいうマップは Chapter 2 で紹介したシーケンス操作で使われる map 関数ではないことです。 百聞一見にしかず、以下の例を通してマップというものをみてみましょう。

            (def m {:cat 3, :dog 2})
            [(m :cat) (m :dog)]
        

上のコードブロックでは m というマップを定義しました。 このマップが持つデータは「:catを3に写し、:dogを2に写す」というものです。 つまり関数のようなものを意味しています。 既にみたように実際 ClojureScript ではマップの使いかたは関数の使いかたととても似ています。

マップは {キー1 値1, キー2 値2, ...} のように書くことができます。 又キー・値の組たちを分断している , は省略しても構いません。

マップに新しいキー・値の組を追加するには (assoc {:cat 3} :dog 2) のように assoc を使うことができます。 又既に存在しているキー・値の組を削除するには (dissoc {:cat 2} :cat) のように dissoc を使うことができます。

演習4.1

以下のコードブロックには names と ages という二つのシーケンスがあります。 table->map を補完して、 (table->map names ages) は {:alice 7, :steve 10, :jacob 17, :john 16} になるようにキーと値それぞれのシーケンスからマップを作る関数にせよ。

            (def names [:alice :steve :jacob :john])
            (def ages [7 10 17 16])
            (defn table->map [names ages]
              {})
        

§4.2. グラフ

コンピュータで扱うデータの種類に、 「グラフ」 というと非常に重要なコンセプトがあります。 グラフは何故重要かといいますと、 現実問題をコンピューターで扱うためにその現実問題の数理モデルをまず与えたいといけない。 そしてグラフは数多くの現実問題の自然な数理モデルになり、 かつグラフに関する計算はコンピューターが得意とするものが多い。

例えば複数の道路と家の町を考え、 Aさんの家からBさんの家まで行くにどのような経路を取れば一番歩く距離が短いという問題はグラフにおける 最短経路問題 にあたります。

一つのグラフは「頂点」の集合と「辺」の集合として考えられています。 例えば上のグラフでは5つの頂点と5つの辺によって構成されています。 グラフの辺にはしばしば例えば長さなどを表す値がついており、 そのような値はよく「ウェイト (weight)」と呼ばれています。

グラフにおける(単一始点単一終点)最短経路問題とは、 一つの頂点(これは起点と呼ぶ)からもう一つの頂点(これは終点と呼ぶ)までの一番短かい経路を計算する問題です。 経路の長さはその通た辺の全てのウェイトの合計として定義されています。

この最短経路問題はコンピューターが得意とする問題の一つであって、 現実問題とも結び付きやすいので、とても重要と言えます。 (最短経路問題はアルゴリズム論での古典的な問題であって、 確立されている解法、つまりアルゴリズムは複数あります。 代表的なのは ダイクストラ法 や フォード法 があります。)

グラフについてはもう一つ重要な問題を紹介したい。 それは 最小全域木問題 です。 以下の例をみてみよう

この例では青の枠線で4つの島を示してます。 そして緑の線は島と島を橋を建てて繋ごうとする場合最適な設置場所と、 その建設費用(赤の数字)を表しています。 今の問題はどのように橋を建てば、最小のコストで四つの橋を繋ぐことができるかです。

この問題もやはりグラフ上の問題として表すことができます。 つまり島それぞれを頂点としてみて、 その間の辺は橋の建設費用とすると、 我々が抱えている現実問題は如何にウェイトの合計が最小になるように辺を選び、 全ての頂点を繋ぐかというグラフの上の問題に帰着することができます。 計算機科学ではちょうど全ての頂点が辺によってすべて繋いでいるグラフを「全域木」だと呼んでいます。 そして一つ既存のグラフから辺を消し、ウェイトの合計が最小になるように全域木を作る問題は最小全域木問題と呼ばれています。 最小全域木も最短経路問題と似ていてコンピューターが得意とする問題の一つであって、 確立されている解法もいくつかあります。 (例えば クラスカル法 や プリム法)

勿論 ClojureScript でアルゴリズムを組み、 最短経路問題や最小全域木問題などを解くことができますが、 そのアルゴリズムの詳細についての説明は NUPSC の講習会の趣旨の一部ではないので、 NUPSC のために用意されているいくつかの関数を用いて現実問題に似せたものをいくつか解いてみよう。 (単純化するため、NUPSC で扱うグラフは全て無向単純グラフでります。)

演習4.2a

NUPSC では以下7つのグラフを作ったり、 操作したりするために用意されている関数があります。

• (empty-graph) は空のグラフ (頂点も辺もないグラフ) を作る関数
• (add-vertex g name) はグラフ g に頂点 name を追加する関数
• (add-edge g from to label) はグラフ g に頂点 from から頂点 to までの、labelをラベルとする辺を追加する関数
• (get-vertices g) はグラフ g の全ての頂点のシーケンスを返す関数
• (get-edges g) は [始点 終点 ラベル] の形で表わされたグラフ g の全ての辺のシーケンスを返す関数
• (remove-vertex g name) はグラフ g から頂点 name を取り除く関数
• (remove-edge g from to) はグラフ g から頂点 from から頂点 to までの辺を取り除く関数

又辺に付けるラベルは任意の値であって、 例えばウェイトがよくラベルとして辺に付けられます。

以下のプログラムを完成させ、 comp-graph が引数であるn個の頂点を持つ完全グラフを作る関数にせよ。 又その返り値の完全グラフの頂点の名前はn未満の自然数とし、 辺にあるラベルは :void にせよ。 但し完全グラフというのは任意の二つの頂点の間は辺が張られているグラフのことである。

            (defn comp-graph [n]
              (empty-graph))
        

演習4.2a

以下の関数を完成させ、 edge-label-func がグラフgを引数として受け取った時、 辺の始点と終点を指定するとそのgにおけるラベルが得られる関数を返す関数にせよ。 例えば以下のグラフに対し、 ((edge-label-func g1) :A :B) は 7 となり、 ((edge-label-func g1) :A :C) は 3 となるようにせよ。

           7
     :A ------- :B
      |
g1:   | 3
      |
     :C

            (defn edge-label-func [g]
              (fn [from to] ??))
        

§4.2c

又 NUPSC では (shortest-path g fweight from to) というグラフgにおいて頂点fromから頂点toの最短経路を計算する関数が用意されています。 fweight は各辺のウェイトを指定する関数であって、 もしウェイトをそのままラベルとして使う場合、 恒等関数 identity として指定すればよいでしょう。 shortest-path は最短な経路を始点と終点を含め途中経過する頂点のシーケンスを返します。

以下のプログラムを完成させ、 辺のラベルがウェイトであるグラフgを受け取った時、 gにおいて頂点fromから頂点toまでの最短経路の長さを返す関数 shortest-path-length を作れ。

            (defn shortest-path-length [g from to]
              (empty-graph))
        

§4.2d

勿論 NUPSC では (minimal-spanning-tree g fweight) というグラフgの最小全域木を計算する関数も用意されています。 shortest-path と同様 fweight は各辺のウェイトを指定する関数です。

以下のプログラムを完成させ、 mst-cost を [x y] のような点の座標のシーケンスを引数pointsとして受けとり、 その全ての点を結ぶに必要な線分の長さの和を計算する関数にせよ。

            (defn mst-cost [points] 0)