Implementation of prim's minimum spanning tree algorithm

project.clj

@@ -1,9 +1,10 @@
 (defproject aysylu/loom "0.4.3-SNAPSHOT"
   :description "Graph library for Clojure"
   :license {:name "Eclipse Public License"
-            :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.4.0"]]
+            :url "http://www.eclipse.org/legal/epl-v10."}
+  :dependencies [[org.clojure/clojure "1.4.0"]
+                 [org.clojure/data.priority-map "0.0.5"]]
   :url "https://github.com/aysylu/loom"
-  :profiles {:dev 
+  :profiles {:dev
              {:dependencies [[org.clojure/clojure "1.5.1"]]}}
   :aliases {"release" ["do" "clean," "with-profile" "default" "deploy" "clojars"]})

src/loom/alg.clj

@@ -6,10 +6,11 @@ can use these functions."
   (:require [loom.alg-generic :as gen]
             [loom.flow :as flow])
   (:require [loom.graph
-             :refer [add-edges nodes edges successors weight predecessors
+             :refer [add-nodes add-edges nodes edges successors weight predecessors
                      out-degree in-degree weighted? directed? graph transpose]
              :as graph]
-            [loom.alg-generic :refer [trace-path preds->span]]))
+            [loom.alg-generic :refer [trace-path preds->span]])
+  (:require [clojure.data.priority-map :as pm]))
 
 ;;;
 ;;; Convenience wrappers for loom.alg-generic functions
@@ -432,4 +433,59 @@ can use these functions."
 
 
 
-;; TODO: MST, coloring, matching, etc etc
+;; mst algorithms
+;; convenience functions for mst algo
+(defn- edge-weights
+  "Wrapper function to return edges along with weights for a given graph.
+   For un-weighted graphs a default value of one is produced. The function
+   returns values of the form [[[u v] 10] [[x y] 20] ...]"
+  [wg v]
+  (let [edge-weight (fn [u v]
+                      (if (weighted? wg) (weight wg u v) 1) )]
+    (map #(vec [[v %1] (edge-weight v %1)])
+         (successors wg v))  )
+  )
+
+(defn prim-mst-edges
+  "An edge-list of an minimum spanning tree along with weights that
+  represents an MST of the given  graph. Returns the MST edge-list
+  for un-weighted graphs."
+  ([wg]
+     (cond
+      (directed? wg) (throw (Exception.
+                             "Spanning tree only defined for undirected graphs"))
+      :else (let [mst (prim-mst-edges wg (nodes wg) nil #{} [])]
+              (if (weighted? wg)
+                mst
+                (map #(vec [(first %1) (second %1)]) mst))))
+     )
+  ([wg n h visited acc]
+     (cond
+      (empty? n) acc
+      (empty? h) (let [v (first n)
+                       h  (into (pm/priority-map) (edge-weights wg v))
+                       ]
+                   (recur wg (disj n v) h (conj visited v) acc))
+      :else (let [next_edge (peek h)
+                  u (first (first next_edge))
+                  v (second (first next_edge))]
+              (if (visited v)
+                (recur wg n (pop h) visited acc)
+                (let [wt (second next_edge)
+                      h (into (pop h) (edge-weights wg v))]
+                  (recur wg (disj n v) h (conj visited v)(conj acc [u v wt]))))))
+     ))
+
+(defn prim-mst
+  "Minimum spanning tree of given graph."
+  [wg]
+  (let [mst (apply graph/weighted-graph (prim-mst-edges wg))
+        ]
+    (cond
+     (= ((comp count nodes) wg) ((comp count nodes) mst)) mst
+     :else (apply add-nodes mst (filter #(zero? (out-degree wg %)) (nodes wg)))
+     )))
+
+
+
+;; ;; Todo: MST, coloring, matching, etc etc

test/loom/test/alg.clj

@@ -107,6 +107,63 @@
            [11 2]
            [11 4]))
 
+
+;; graphs for mst
+;; http://en.wikipedia.org/wiki/Kruskal%27s_algorithm
+(def mst_wt_g1 (weighted-graph '(:a,:d, 5)
+                        '(:a,:b,7)
+                        '(:b,:d,9),
+                        '(:b,:c,8),
+                        '(:b,:e,7)
+                        '(:d,:e,15)
+                        '(:d,:f,6)
+                        '(:c,:e,5)
+                        '(:e,:f,8)
+                        '(:e,:g,9)
+                        '(:f,:g,11)))
+
+;; http://en.wikipedia.org/wiki/Kruskal's_algorithm
+(def mst_wt_g1 (weighted-graph '(:a, :e , 1)
+                        '(:c, :d ,2)
+                        '(:a,:b, 3),
+                        '(:b,:e,4),
+                        '(:b,:c,5)
+                        '(:e,:c,6)
+                        '(:e,:d,7)))
+
+;;graph with 2 components
+(def mst_wt_g2 (weighted-graph [:a :b 2]
+                              [:a :d 1]
+                              [:b :d 2]
+                              [:c :d 3]
+                              [:b :c 1]
+                              [:e :f 1]
+                             ))
+
+(def mst_unweighted_g3 (graph [:a :b] [:a :c] [:a :d] [:b :d] [:c :d]))
+
+(def mst_wt_g4 (weighted-graph [:a :b 1]))
+
+(def mst_wt_g5 (weighted-graph [:a :b 5] [:a :c 2] [:b :c 2]))
+
+;;graph from Cormen et all
+(def mst_wt_g6 (weighted-graph [:a :b 4] [:a :h 8]
+                               [:b :c 8] [:b :h 11]
+                               [:c :d 7] [:c :f 4] [:c :i 2]
+                               [:d :f 14] [:d :e 9]
+                               [:e :f 10]
+                               [:f :g 2]
+                               [:i :h 7] [:i :g 6]
+                               [:h :g 1] ))
+
+
+;;graph with 2 components and 2 isolated nodes
+(def mst_wt_g7 (weighted-graph [:a :b 2]
+                               [:b :d 2]
+                               [:e :f 1]
+                               :g :h
+                             ))
+
 (deftest depth-first-test
   (are [expected got] (= expected got)
        #{1 2 3 5 6 7} (set (pre-traverse g7))
@@ -249,3 +306,21 @@
 (deftest scc-test
   (are [expected got] (= expected got)
        #{#{2 4 10} #{1 3 5 6} #{11} #{7 8 9}} (set (map set (scc g13)))))
+
+(deftest prim-mst-edges-test
+  (are [expected got] (= expected got)
+       [[:a :e 1] [:a :b 3] [:b :c 5] [:c :d 2]] (prim-mst-edges mst_wt_g1)
+       [[:a :d 1] [:a :b 2] [:b :c 1] [:f :e 1]] (prim-mst-edges mst_wt_g2)
+       [[:a :c] [:a :b] [:b :d]] (prim-mst-edges mst_unweighted_g3)
+       [[:a :b 1]] (prim-mst-edges mst_wt_g4)
+       [[:a :c 2] [:c :b 2]] (prim-mst-edges mst_wt_g5)
+       [[:a :b 4] [:b :c 8] [:c :i 2] [:c :f 4] [:f :g 2]
+        [:g :h 1] [:c :d 7] [:d :e 9]]  (prim-mst-edges mst_wt_g6)))
+
+(deftest prim-mst-test
+  (are [expected got] (= expected got)
+       [#{:a :b :d :e :f :g :h} [[:a :b][:b :d][:b :a][:f :e][:d :b][:e :f]]]
+       (let [mst (prim-mst mst_wt_g7)]
+         [(nodes mst) (edges mst)])
+       [#{:a :b :c} [[:a :c] [:c :b] [:c :a] [:b :c]]] (let [mst (prim-mst mst_wt_g5)]
+              [(nodes mst) (edges mst)])))