Added component-graph

1 files changed, 19 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."