1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/test_graph.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,187 @@
     1.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  test-graph
    1.13 +;;
    1.14 +;;  Basic Graph Theory Algorithms Tests
    1.15 +;;
    1.16 +;;  straszheimjeffrey (gmail)
    1.17 +;;  Created 23 June 2009
    1.18 +
    1.19 +(ns clojure.contrib.test-graph
    1.20 +  (use clojure.test
    1.21 +       clojure.contrib.graph))
    1.22 +
    1.23 +
    1.24 +(def empty-graph (struct directed-graph #{} {}))
    1.25 +
    1.26 +(def test-graph-1
    1.27 +     (struct directed-graph
    1.28 +             #{:a :b :c :d :e}
    1.29 +             {:a #{:b :c}
    1.30 +              :b #{:a :c}
    1.31 +              :c #{:d :e}
    1.32 +              :d #{:a :b}
    1.33 +              :e #{:d}}))
    1.34 +
    1.35 +(deftest test-reverse-graph
    1.36 +  (is (= (reverse-graph test-graph-1)
    1.37 +         (struct directed-graph
    1.38 +                 #{:a :b :c :d :e}
    1.39 +                 {:c #{:b :a}
    1.40 +                  :e #{:c}
    1.41 +                  :d #{:c :e}
    1.42 +                  :b #{:d :a}
    1.43 +                  :a #{:d :b}})))
    1.44 +  (is (= (reverse-graph (reverse-graph test-graph-1))
    1.45 +         test-graph-1))
    1.46 +  (is (= (reverse-graph empty-graph) empty-graph)))
    1.47 +
    1.48 +(deftest test-add-loops
    1.49 +  (let [tg1 (add-loops test-graph-1)]
    1.50 +    (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
    1.51 +  (is (= (add-loops empty-graph) empty-graph)))
    1.52 +
    1.53 +(deftest test-remove-loops
    1.54 +  (let [tg1 (remove-loops (add-loops test-graph-1))]
    1.55 +    (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
    1.56 +  (is (= (remove-loops empty-graph) empty-graph)))
    1.57 +
    1.58 +
    1.59 +(def test-graph-2
    1.60 +     (struct directed-graph
    1.61 +             #{:a :b :c :d :e :f :g :h :i :j}
    1.62 +             {:a #{:b :c}
    1.63 +              :b #{:a :c} 
    1.64 +              :c #{:d :e}
    1.65 +              :d #{:a :b}
    1.66 +              :e #{:d}
    1.67 +              :f #{:f}
    1.68 +              :g #{:a :f}
    1.69 +              :h #{}
    1.70 +              :i #{:j}
    1.71 +              :j #{:i}}))
    1.72 +
    1.73 +
    1.74 +(deftest test-lazy-walk
    1.75 +  (is (= (lazy-walk test-graph-2 :h) [:h]))
    1.76 +  (is (= (lazy-walk test-graph-2 :j) [:j :i])))
    1.77 +
    1.78 +(deftest test-transitive-closure
    1.79 +  (let [tc-1 (transitive-closure test-graph-1)
    1.80 +        tc-2 (transitive-closure test-graph-2)
    1.81 +        get (fn [n] (set (get-neighbors tc-2 n)))]
    1.82 +    (is (every? #(= #{:a :b :c :d :e} (set %))
    1.83 +                (map (partial get-neighbors tc-1) (:nodes tc-1))))
    1.84 +    (is (= (get :a) #{:a :b :c :d :e}))
    1.85 +    (is (= (get :h) #{}))
    1.86 +    (is (= (get :j) #{:i :j}))
    1.87 +    (is (= (get :g) #{:a :b :c :d :e :f}))))
    1.88 +
    1.89 +
    1.90 +(deftest test-post-ordered-nodes
    1.91 +  (is (= (set (post-ordered-nodes test-graph-2))
    1.92 +         #{:a :b :c :d :e :f :g :h :i :j}))
    1.93 +  (is (empty? (post-ordered-nodes empty-graph))))
    1.94 +
    1.95 +
    1.96 +(deftest test-scc
    1.97 +  (is (= (set (scc test-graph-2))
    1.98 +         #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}}))
    1.99 +  (is (empty? (scc empty-graph))))
   1.100 +
   1.101 +(deftest test-component-graph
   1.102 +  (let [cg (component-graph test-graph-2)
   1.103 +        ecg (component-graph empty-graph)]
   1.104 +    (is (= (:nodes cg) (set (scc test-graph-2))))
   1.105 +    (is (= (get-neighbors cg #{:a :b :c :d :e})
   1.106 +           #{#{:a :b :c :d :e}}))
   1.107 +    (is (= (get-neighbors cg #{:g})
   1.108 +           #{#{:a :b :c :d :e} #{:f}}))
   1.109 +    (is (= (get-neighbors cg #{:i :j})
   1.110 +           #{#{:i :j}}))
   1.111 +    (is (= (get-neighbors cg #{:h})
   1.112 +           #{}))
   1.113 +    (is (= (apply max (map count (self-recursive-sets cg))) 1))
   1.114 +    (is (= ecg empty-graph))))
   1.115 +
   1.116 +
   1.117 +(deftest test-recursive-component?
   1.118 +  (let [sccs (scc test-graph-2)]
   1.119 +    (is (= (set (filter (partial recursive-component? test-graph-2) sccs))
   1.120 +           #{#{:i :j} #{:b :c :a :d :e} #{:f}}))))
   1.121 +
   1.122 +
   1.123 +(deftest test-self-recursive-sets
   1.124 +  (is (= (set (self-recursive-sets test-graph-2))
   1.125 +         (set (filter
   1.126 +               (partial recursive-component? test-graph-2)
   1.127 +               (scc test-graph-2)))))
   1.128 +  (is (empty? (self-recursive-sets empty-graph))))
   1.129 +
   1.130 +
   1.131 +(def test-graph-3
   1.132 +     (struct directed-graph
   1.133 +             #{:a :b :c :d :e :f}
   1.134 +             {:a #{:b}
   1.135 +              :b #{:c}
   1.136 +              :c #{:d}
   1.137 +              :d #{:e}
   1.138 +              :e #{:f}
   1.139 +              :f #{}}))
   1.140 +
   1.141 +(def test-graph-4
   1.142 +     (struct directed-graph
   1.143 +             #{:a :b :c :d :e :f :g :h}
   1.144 +             {:a #{}
   1.145 +              :b #{:a}
   1.146 +              :c #{:a}
   1.147 +              :d #{:a :b}
   1.148 +              :e #{:d :c}
   1.149 +              :f #{:e}
   1.150 +              :g #{:d}
   1.151 +              :h #{:f}}))
   1.152 +
   1.153 +(def test-graph-5
   1.154 +     (struct directed-graph
   1.155 +             #{:a :b :c :d :e :f :g :h}
   1.156 +             {:a #{}
   1.157 +              :b #{}
   1.158 +              :c #{:b}
   1.159 +              :d #{}
   1.160 +              :e #{}
   1.161 +              :f #{}
   1.162 +              :g #{:f}
   1.163 +              :h #{}}))
   1.164 +
   1.165 +(deftest test-dependency-list
   1.166 +  (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
   1.167 +                        (dependency-list test-graph-2)))
   1.168 +  (is (= (dependency-list test-graph-3)
   1.169 +         [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}]))
   1.170 +  (is (= (dependency-list test-graph-4)
   1.171 +         [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}]))
   1.172 +  (is (= (dependency-list test-graph-5)
   1.173 +         [#{:f :b :a :d :h :e} #{:g :c}]))
   1.174 +  (is (= (dependency-list empty-graph)
   1.175 +         [#{}])))
   1.176 +
   1.177 +(deftest test-stratification-list
   1.178 +  (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
   1.179 +                        (stratification-list test-graph-2 test-graph-2)))
   1.180 +  (is (= (stratification-list test-graph-4 test-graph-5)
   1.181 +         [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}]))
   1.182 +  (is (= (stratification-list empty-graph empty-graph)
   1.183 +         [#{}])))
   1.184 +
   1.185 +(comment
   1.186 +  (run-tests)
   1.187 +)
   1.188 +
   1.189 +
   1.190 +;; End of file