diff options
Diffstat (limited to 'src/clojure/contrib/test_contrib/test_graph.clj')
-rw-r--r-- | src/clojure/contrib/test_contrib/test_graph.clj | 187 |
1 files changed, 0 insertions, 187 deletions
diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj deleted file mode 100644 index ed03b9ae..00000000 --- a/src/clojure/contrib/test_contrib/test_graph.clj +++ /dev/null @@ -1,187 +0,0 @@ -;; 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-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 |