Add test sources to their respective modules

1 files changed, 187 insertions, 0 deletions

diff --git a/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj b/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj
new file mode 100644
index 00000000..c27df8bf
--- /dev/null
+++ b/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj
@@ -0,0 +1,187 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-graph
+;;
+;;  Basic Graph Theory Algorithms Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 23 June 2009
+
+(ns clojure.contrib.test-graph
+  (use clojure.test
+       clojure.contrib.graph))
+
+
+(def empty-graph (struct directed-graph #{} {}))
+
+(def test-graph-1
+     (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)
+         (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)))
+
+(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}
+             {: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-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) #{}))
+    (is (= (get :j) #{:i :j}))
+    (is (= (get :g) #{:a :b :c :d :e :f}))))
+
+
+(deftest test-post-ordered-nodes
+  (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 (= (set (scc test-graph-2))
+         #{#{: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 (= (apply max (map count (self-recursive-sets cg))) 1))
+    (is (= ecg empty-graph))))
+
+
+(deftest test-recursive-component?
+  (let [sccs (scc test-graph-2)]
+    (is (= (set (filter (partial recursive-component? test-graph-2) sccs))
+           #{#{:i :j} #{:b :c :a :d :e} #{:f}}))))
+
+
+(deftest test-self-recursive-sets
+  (is (= (set (self-recursive-sets test-graph-2))
+         (set (filter
+               (partial recursive-component? test-graph-2)
+               (scc test-graph-2)))))
+  (is (empty? (self-recursive-sets empty-graph))))
+
+
+(def test-graph-3
+     (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
+             #{: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)
+         [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}]))
+  (is (= (dependency-list test-graph-4)
+         [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}]))
+  (is (= (dependency-list test-graph-5)
+         [#{:f :b :a :d :h :e} #{:g :c}]))
+  (is (= (dependency-list empty-graph)
+         [#{}])))
+
+(deftest test-stratification-list
+  (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)
+         [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}]))
+  (is (= (stratification-list empty-graph empty-graph)
+         [#{}])))
+
+(comment
+  (run-tests)
+)
+
+
+;; End of file