Saner node structure

2 files changed, 102 insertions, 174 deletions

diff --git a/src/clojure/contrib/graph.clj b/src/clojure/contrib/graph.clj
index 9418abab..e42aa852 100644
--- a/src/clojure/contrib/graph.clj
+++ b/src/clojure/contrib/graph.clj
@@ -14,15 +14,14 @@
 ;;  Created 23 June 2009
 
 (ns clojure.contrib.graph
-  (use [clojure.contrib.macros :only (letfn)])
   (use [clojure.contrib.seq-utils :only (flatten indexed)]))
 
 
 
 (defstruct directed-graph
-  :count       ; The count of nodes in the graph
-  :neighbors)  ; A function that, given a node (0 .. count-1) returns
-               ; a collection neighbor nodes.
+  :nodes       ; The nodes of the graph, a collection
+  :neighbors)  ; A function that, given a node a collection neighbor
+               ; nodes.
 
 (defn get-neighbors
   "Get the neighbors of a node."
@@ -30,6 +29,8 @@
   ((:neighbors g) n))
 
 
+;; Reverse Graph
+
 (defn reverse-graph
   "Given a directed graph, return another directed graph with the
    order of the edges reversed."
@@ -37,25 +38,13 @@
   (let [op (fn [rna idx]
              (let [ns (get-neighbors g idx)
                    am (fn [m val]
-                        (assoc m val (conj (get m val []) idx)))]
+                        (assoc m val (conj (get m val #{}) idx)))]
                (reduce am rna ns)))
-        rn (reduce op {} (range (:count g)))]
-    (struct directed-graph (:count g) rn)))
-
-(comment
-  (def test-graph-1
-       (struct directed-graph 5
-               {0 [1 2]
-                1 [0 2]
-                2 [3 4]
-                3 [0 1]
-                4 [3]}))
-
-  test-graph-1
-  (reverse-graph test-graph-1)
-  (reverse-graph (reverse-graph test-graph-1))
-  (= test-graph-1 (reverse-graph (reverse-graph test-graph-1)))
-)
+        rn (reduce op {} (:nodes g))]
+    (struct directed-graph (:nodes g) rn)))
+
+
+;; Strongly Connected Components
 
 (defn- post-ordered-visit
   "Starting at node n, perform a post-ordered walk."
@@ -72,7 +61,7 @@
   [g]
   (fnext (reduce #(post-ordered-visit g %2 %1)
                  [#{} []]
-                 (range (:count g)))))
+                 (:nodes g))))
 
 (defn scc
   "Returns, as a sequence of sets, the strongly connected components
@@ -94,34 +83,13 @@
   "Returns, as a sequence of sets, the components of a graph that are
    self-recursive."
   [g]
-  (letfn [recursive? [n]
-            (or (> (count n) 1)
-                (some n (get-neighbors g (first n))))]
-     (filter recursive? (scc g))))
+  (let [recursive? (fn [n]
+                     (or (> (count n) 1)
+                         (some n (get-neighbors g (first n)))))]
+    (filter recursive? (scc g))))
                           
-(comment
-
-  (def test-graph-2
-       (struct directed-graph 10
-               {0 [1 2]
-                1 [0 2]
-                2 [3 4]
-                3 [0 1]
-                4 [3]
-                5 [5]
-                6 [0 5]
-                7 []
-                8 [9]
-                9 [8]}))
-
-
-  (post-ordered-visit test-graph-2 0 [#{} []])
-  (post-ordered-nodes test-graph-2)
-  (scc test-graph-2)
-  (self-recursive-sets test-graph-2)
-
-)
 
+;; Dependency Lists
 
 (defn fixed-point
   "Repeatedly apply fun to data until (equal old-data new-data)
@@ -139,11 +107,12 @@
                   
 (defn- fold-into-sets
   [priorities]
-  (let [step (fn [acc [idx dep]]
-               (assoc acc dep (conj (acc dep) idx)))]
+  (let [max (inc (apply max 0 (vals priorities)))
+        step (fn [acc [n dep]]
+               (assoc acc dep (conj (acc dep) n)))]
     (reduce step
-            (vec (replicate (inc (apply max 0 priorities)) #{}))
-            (indexed priorities))))
+            (vec (replicate max #{}))
+            priorities)))
             
 (defn dependency-list
   "Similar to a topological sort, this returns a vector of sets, each
@@ -154,10 +123,10 @@
   (let [step (fn [d]
                (let [update (fn [n]
                               (inc (apply max -1 (map d (get-neighbors g n)))))]
-                 (vec (map update (range (:count g))))))
-        counts (fixed-point (vec (replicate (:count g) 0))
+                 (into {} (map (fn [[k v]] [k (update k)]) d))))
+        counts (fixed-point (zipmap (:nodes g) (repeat 0))
                             step
-                            (inc (:count g))
+                            (inc (count (:nodes g)))
                             =)]
     (fold-into-sets counts)))
     
@@ -168,65 +137,18 @@
    depends on node b (meaning an edge a->b exists) in the second
    graph, node a must be equal or later in the sequence."
   [g1 g2]
-  (assert (= (:count g1) (:count g2)))
+  (assert (= (-> g1 :nodes set) (-> g2 :nodes set)))
   (let [step (fn [d]
-               (letfn [update [n]
-                       (max (inc (apply max -1
-                                        (map d (get-neighbors g1 n))))
-                            (apply max -1 (map d (get-neighbors g2 n))))]
-                  (vec (map update (range (:count g1))))))
-        counts (fixed-point (vec (replicate (:count g1) 0))
+               (let [update (fn [n]
+                              (max (inc (apply max -1
+                                               (map d (get-neighbors g1 n))))
+                                   (apply max -1 (map d (get-neighbors g2 n)))))]
+                 (into {} (map (fn [[k v]] [k (update k)]) d))))
+        counts (fixed-point (zipmap (:nodes g1) (repeat 0))
                             step
-                            (inc (:count g1))
+                            (inc (count (:nodes g1)))
                             =)]
     (fold-into-sets counts)))
-        
-    
-
-(comment
-
-  (dependency-list test-graph-2)
-
-  (def test-graph-3
-       (struct directed-graph 6
-               {0 [1]
-                1 [2]
-                2 [3]
-                3 [4]
-                4 [5]
-                5 []}))
-
-  (dependency-list test-graph-3)
-
-  (def test-graph-4
-       (struct directed-graph 8
-               {0 []
-                1 [0]
-                2 [0]
-                3 [0 1]
-                4 [3 2]
-                5 [4]
-                6 [3]
-                7 [5]}))
-
-  (dependency-list test-graph-4)
-
-  (def test-graph-5
-       (struct directed-graph 8
-               {0 []
-                1 []
-                2 [1]
-                3 []
-                4 []
-                5 []
-                6 [5]
-                7 []}))
-
-  (dependency-list test-graph-5)
-  (stratification-list test-graph-4 test-graph-5)
-
-)
-
 
 
 ;; End of file
\ No newline at end of file
diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj
index 07a22b4d..248203fd 100644
--- a/src/clojure/contrib/test_contrib/test_graph.clj
+++ b/src/clojure/contrib/test_contrib/test_graph.clj
@@ -14,103 +14,109 @@
 ;;  Created 23 June 2009
 
 (ns clojure.contrib.test-contrib.test-graph
-  (use clojure.contrib.test-is
+  (use :reload clojure.contrib.test-is
        clojure.contrib.graph))
 
 
-(def empty-graph (struct directed-graph 0 {}))
+(def empty-graph (struct directed-graph #{} {}))
 
 (def test-graph-1
-     (struct directed-graph 5
-             {0 [1 2]
-              1 [0 2]
-              2 [3 4]
-              3 [0 1]
-              4 [3]}))
+     (struct directed-graph
+             #{:a :b :c :d :e}
+             {:a #{:b :c}
+              :b #{:a :c}
+              :c #{:d :e}
+              :d #{:a :b}
+              :e #{:d}}))
 
 (deftest test-reverse-graph
   (is (= (reverse-graph test-graph-1)
-         {:count 5, :neighbors {
-                                0 [1 3]
-                                1 [0 3]
-                                2 [0 1]
-                                3 [2 4]
-                                4 [2]}}))
+         (struct directed-graph
+                 #{:a :b :c :d :e}
+                 {:c #{:b :a}
+                  :e #{:c}
+                  :d #{:c :e}
+                  :b #{:d :a}
+                  :a #{:d :b}})))
   (is (= (reverse-graph (reverse-graph test-graph-1))
          test-graph-1))
   (is (= (reverse-graph empty-graph) empty-graph)))
 
 (def test-graph-2
-     (struct directed-graph 10
-             {0 [1 2]
-              1 [0 2]
-              2 [3 4]
-              3 [0 1]
-              4 [3]
-              5 [5]
-              6 [0 5]
-              7 []
-              8 [9]
-              9 [8]}))
+     (struct directed-graph
+             #{:a :b :c :d :e :f :g :h :i :j}
+             {:a #{:b :c}
+              :b #{:a :c} 
+              :c #{:d :e}
+              :d #{:a :b}
+              :e #{:d}
+              :f #{:f}
+              :g #{:a :f}
+              :h #{}
+              :i #{:j}
+              :j #{:i}}))
 
 (deftest test-post-ordered-nodes
-  (is (= (post-ordered-nodes test-graph-2)
-         [3 4 2 1 0 5 6 7 9 8]))
+  (is (= (set (post-ordered-nodes test-graph-2))
+         #{:a :b :c :d :e :f :g :h :i :j}))
   (is (empty? (post-ordered-nodes empty-graph))))
 
 
 (deftest test-scc
-  (is (= (scc test-graph-2)
-         [#{8 9} #{7} #{6} #{5} #{0 1 2 3 4}]))
+  (is (= (set (scc test-graph-2))
+         #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}}))
   (is (empty? (scc empty-graph))))
 
 
 (deftest test-self-recursive-sets
-  (is (= (self-recursive-sets test-graph-2)
-         [#{8 9} #{5} #{0 1 2 3 4}]))
+  (is (= (set (self-recursive-sets test-graph-2))
+         #{#{:i :j} #{:b :c :a :d :e} #{:f}}))
   (is (empty? (self-recursive-sets empty-graph))))
 
 
 (def test-graph-3
-     (struct directed-graph 6
-             {0 [1]
-              1 [2]
-              2 [3]
-              3 [4]
-              4 [5]
-              5 []}))
+     (struct directed-graph
+             #{:a :b :c :d :e :f}
+             {:a #{:b}
+              :b #{:c}
+              :c #{:d}
+              :d #{:e}
+              :e #{:f}
+              :f #{}}))
 
 (def test-graph-4
-     (struct directed-graph 8
-             {0 []
-              1 [0]
-              2 [0]
-              3 [0 1]
-              4 [3 2]
-              5 [4]
-              6 [3]
-              7 [5]}))
-
-  (def test-graph-5
-       (struct directed-graph 8
-               {0 []
-                1 []
-                2 [1]
-                3 []
-                4 []
-                5 []
-                6 [5]
-                7 []}))
+     (struct directed-graph
+             #{:a :b :c :d :e :f :g :h}
+             {:a #{}
+              :b #{:a}
+              :c #{:a}
+              :d #{:a :b}
+              :e #{:d :c}
+              :f #{:e}
+              :g #{:d}
+              :h #{:f}}))
+
+(def test-graph-5
+     (struct directed-graph
+             #{:a :b :c :d :e :f :g :h}
+             {:a #{}
+              :b #{}
+              :c #{:b}
+              :d #{}
+              :e #{}
+              :f #{}
+              :g #{:f}
+              :h #{}}))
 
 (deftest test-dependency-list
   (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
                         (dependency-list test-graph-2)))
   (is (= (dependency-list test-graph-3)
-         [#{5} #{4} #{3} #{2} #{1} #{0}]))
+         [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}]))
   (is (= (dependency-list test-graph-4)
-         [#{0} #{1 2} #{3} #{4 6} #{5} #{7}]))
+         [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}]))
   (is (= (dependency-list test-graph-5)
-         [#{0 1 3 4 5 7} #{2 6}]))
+         [#{:f :b :a :d :h :e} #{:g :c}]))
   (is (= (dependency-list empty-graph)
          [#{}])))
 
@@ -118,7 +124,7 @@
   (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
                         (stratification-list test-graph-2 test-graph-2)))
   (is (= (stratification-list test-graph-4 test-graph-5)
-         [#{0} #{1 2} #{3} #{4} #{5 6} #{7}]))
+         [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}]))
   (is (= (stratification-list empty-graph empty-graph)
          [#{}])))
 
@@ -127,4 +133,4 @@
 )
 
 
-
+;; End of file