Added transitive-closure

2 files changed, 71 insertions, 5 deletions

diff --git a/src/clojure/contrib/graph.clj b/src/clojure/contrib/graph.clj
index 7508f3ea..a1e82a25 100644
--- a/src/clojure/contrib/graph.clj
+++ b/src/clojure/contrib/graph.clj
@@ -28,7 +28,7 @@
   ((:neighbors g) n))
 
 
-;; Reverse Graph
+;; Graph Modification
 
 (defn reverse-graph
   "Given a directed graph, return another directed graph with the
@@ -42,7 +42,49 @@
         rn (reduce op {} (:nodes g))]
     (struct directed-graph (:nodes g) rn)))
 
+(defn add-loops
+  "For each node n, add the edge n->n if not already present."
+  [g]
+  (struct directed-graph
+          (:nodes g)
+          (into {} (map (fn [n]
+                          [n (conj (set (get-neighbors g n)) n)]) (:nodes g)))))
 
+(defn remove-loops
+  "For each node n, remove any edges n->n."
+  [g]
+  (struct directed-graph
+          (:nodes g)
+          (into {} (map (fn [n]
+                          [n (disj (set (get-neighbors g n)) n)]) (:nodes g)))))
+
+
+;; Graph Walk
+
+(defn lazy-walk
+  "Return a lazy sequence of the nodes of a graph starting a node n.  Optionally,
+   provide a set of visited notes (v) and a collection of nodes to
+   visit (ns)."
+  ([g n]
+     (lazy-walk g [n] #{}))
+  ([g ns v]
+     (lazy-seq (let [s (seq ns)
+                     n (first s)
+                     ns (rest ns)]
+                 (when s
+                   (if (v n)
+                     (lazy-walk g ns v)
+                     (cons n (lazy-walk g (concat (get-neighbors g n) ns) (conj v n)))))))))
+
+(defn transitive-closure
+  "Returns the transitive closure of a graph.  The neighbors are lazily computed."
+  [g]
+  (let [nbs (into {} (map (fn [n] [n (delay (lazy-walk g n))]) (:nodes g)))]
+    (struct directed-graph
+            (:nodes g)
+            (fn [n] (force (nbs n))))))
+          
+                
 ;; Strongly Connected Components
 
 (defn- post-ordered-visit
diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj
index 3becdd25..85983d28 100644
--- a/src/clojure/contrib/test_contrib/test_graph.clj
+++ b/src/clojure/contrib/test_contrib/test_graph.clj
@@ -42,6 +42,17 @@
          test-graph-1))
   (is (= (reverse-graph empty-graph) empty-graph)))
 
+(deftest test-add-loops
+  (let [tg1 (add-loops test-graph-1)]
+    (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
+  (is (= (add-loops empty-graph) empty-graph)))
+
+(deftest test-remove-loops
+  (let [tg1 (remove-loops (add-loops test-graph-1))]
+    (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
+  (is (= (remove-loops empty-graph) empty-graph)))
+
+
 (def test-graph-2
      (struct directed-graph
              #{:a :b :c :d :e :f :g :h :i :j}
@@ -56,6 +67,23 @@
               :i #{:j}
               :j #{:i}}))
 
+
+(deftest test-lazy-walk
+  (is (= (lazy-walk test-graph-2 :h) [:h]))
+  (is (= (lazy-walk test-graph-2 :j) [:j :i])))
+
+(deftest test-transitive-closure
+  (let [tc-1 (transitive-closure test-graph-1)
+        tc-2 (transitive-closure test-graph-2)
+        get (fn [n] (set (get-neighbors tc-2 n)))]
+    (is (every? #(= #{:a :b :c :d :e} (set %))
+                (map (partial get-neighbors tc-1) (:nodes tc-1))))
+    (is (= (get :a) #{:a :b :c :d :e}))
+    (is (= (get :h) #{:h}))
+    (is (= (get :j) #{:i :j}))
+    (is (= (get :g) #{:a :b :c :d :e :f :g}))))
+
+
 (deftest test-post-ordered-nodes
   (is (= (set (post-ordered-nodes test-graph-2))
          #{:a :b :c :d :e :f :g :h :i :j}))
@@ -82,10 +110,6 @@
     (is (= (apply max (map count (self-recursive-sets cg))) 1))
     (is (= ecg empty-graph))))
 
-(comment
-  (run-tests)
-)
-
 
 (deftest test-self-recursive-sets
   (is (= (set (self-recursive-sets test-graph-2))