diff options
| -rw-r--r-- | src/clojure/contrib/graph.clj | 20 | ||||
| -rw-r--r-- | src/clojure/contrib/test_contrib/test_graph.clj | 18 |
2 files changed, 37 insertions, 1 deletions
diff --git a/src/clojure/contrib/graph.clj b/src/clojure/contrib/graph.clj index 1979c0db..94199893 100644 --- a/src/clojure/contrib/graph.clj +++ b/src/clojure/contrib/graph.clj @@ -13,7 +13,8 @@ ;; straszheimjeffrey (gmail) ;; Created 23 June 2009 -(ns clojure.contrib.graph) +(ns clojure.contrib.graph + (use [clojure.set :only (union)])) (defstruct directed-graph @@ -77,6 +78,23 @@ (recur ns nv (conj acc comp)))))] (step po #{} []))) +(defn component-graph + "Given a graph, perhaps with cycles, return a reduced graph that is acyclic. + Each node in the new graph will be a set of nodes from the old. + These sets are the strongly connected components. Each edge will + be the union of all the edges of the prior graph." + [g] + (let [sccs (scc g) + find-node-set (fn [n] + (some #(if (% n) % nil) sccs)) + find-neighbors (fn [ns] + (let [nbs1 (map (partial get-neighbors g) ns) + nbs2 (map set nbs1) + nbs3 (apply union nbs2)] + (set (map find-node-set nbs3)))) + nm (into {} (map (fn [ns] [ns (find-neighbors ns)]) sccs))] + (struct directed-graph (set sccs) nm))) + (defn self-recursive-sets "Returns, as a sequence of sets, the components of a graph that are self-recursive." diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj index 248203fd..6638fa4c 100644 --- a/src/clojure/contrib/test_contrib/test_graph.clj +++ b/src/clojure/contrib/test_contrib/test_graph.clj @@ -67,6 +67,24 @@ #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}})) (is (empty? (scc empty-graph)))) +(deftest test-component-graph + (let [cg (component-graph test-graph-2) + ecg (component-graph empty-graph)] + (is (= (:nodes cg) (set (scc test-graph-2)))) + (is (= (get-neighbors cg #{:a :b :c :d :e}) + #{#{:a :b :c :d :e}})) + (is (= (get-neighbors cg #{:g}) + #{#{:a :b :c :d :e} #{:f}})) + (is (= (get-neighbors cg #{:i :j}) + #{#{:i :j}})) + (is (= (get-neighbors cg #{:h}) + #{})) + (is (= ecg empty-graph)))) + +(comment + (run-tests) +) + (deftest test-self-recursive-sets (is (= (set (self-recursive-sets test-graph-2)) |