Mercurial > lasercutter
comparison src/clojure/contrib/test_contrib/test_graph.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and | |
2 ;; distribution terms for this software are covered by the Eclipse Public | |
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can | |
4 ;; be found in the file epl-v10.html at the root of this distribution. By | |
5 ;; using this software in any fashion, you are agreeing to be bound by the | |
6 ;; terms of this license. You must not remove this notice, or any other, | |
7 ;; from this software. | |
8 ;; | |
9 ;; test-graph | |
10 ;; | |
11 ;; Basic Graph Theory Algorithms Tests | |
12 ;; | |
13 ;; straszheimjeffrey (gmail) | |
14 ;; Created 23 June 2009 | |
15 | |
16 (ns clojure.contrib.test-graph | |
17 (use clojure.test | |
18 clojure.contrib.graph)) | |
19 | |
20 | |
21 (def empty-graph (struct directed-graph #{} {})) | |
22 | |
23 (def test-graph-1 | |
24 (struct directed-graph | |
25 #{:a :b :c :d :e} | |
26 {:a #{:b :c} | |
27 :b #{:a :c} | |
28 :c #{:d :e} | |
29 :d #{:a :b} | |
30 :e #{:d}})) | |
31 | |
32 (deftest test-reverse-graph | |
33 (is (= (reverse-graph test-graph-1) | |
34 (struct directed-graph | |
35 #{:a :b :c :d :e} | |
36 {:c #{:b :a} | |
37 :e #{:c} | |
38 :d #{:c :e} | |
39 :b #{:d :a} | |
40 :a #{:d :b}}))) | |
41 (is (= (reverse-graph (reverse-graph test-graph-1)) | |
42 test-graph-1)) | |
43 (is (= (reverse-graph empty-graph) empty-graph))) | |
44 | |
45 (deftest test-add-loops | |
46 (let [tg1 (add-loops test-graph-1)] | |
47 (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) | |
48 (is (= (add-loops empty-graph) empty-graph))) | |
49 | |
50 (deftest test-remove-loops | |
51 (let [tg1 (remove-loops (add-loops test-graph-1))] | |
52 (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) | |
53 (is (= (remove-loops empty-graph) empty-graph))) | |
54 | |
55 | |
56 (def test-graph-2 | |
57 (struct directed-graph | |
58 #{:a :b :c :d :e :f :g :h :i :j} | |
59 {:a #{:b :c} | |
60 :b #{:a :c} | |
61 :c #{:d :e} | |
62 :d #{:a :b} | |
63 :e #{:d} | |
64 :f #{:f} | |
65 :g #{:a :f} | |
66 :h #{} | |
67 :i #{:j} | |
68 :j #{:i}})) | |
69 | |
70 | |
71 (deftest test-lazy-walk | |
72 (is (= (lazy-walk test-graph-2 :h) [:h])) | |
73 (is (= (lazy-walk test-graph-2 :j) [:j :i]))) | |
74 | |
75 (deftest test-transitive-closure | |
76 (let [tc-1 (transitive-closure test-graph-1) | |
77 tc-2 (transitive-closure test-graph-2) | |
78 get (fn [n] (set (get-neighbors tc-2 n)))] | |
79 (is (every? #(= #{:a :b :c :d :e} (set %)) | |
80 (map (partial get-neighbors tc-1) (:nodes tc-1)))) | |
81 (is (= (get :a) #{:a :b :c :d :e})) | |
82 (is (= (get :h) #{})) | |
83 (is (= (get :j) #{:i :j})) | |
84 (is (= (get :g) #{:a :b :c :d :e :f})))) | |
85 | |
86 | |
87 (deftest test-post-ordered-nodes | |
88 (is (= (set (post-ordered-nodes test-graph-2)) | |
89 #{:a :b :c :d :e :f :g :h :i :j})) | |
90 (is (empty? (post-ordered-nodes empty-graph)))) | |
91 | |
92 | |
93 (deftest test-scc | |
94 (is (= (set (scc test-graph-2)) | |
95 #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}})) | |
96 (is (empty? (scc empty-graph)))) | |
97 | |
98 (deftest test-component-graph | |
99 (let [cg (component-graph test-graph-2) | |
100 ecg (component-graph empty-graph)] | |
101 (is (= (:nodes cg) (set (scc test-graph-2)))) | |
102 (is (= (get-neighbors cg #{:a :b :c :d :e}) | |
103 #{#{:a :b :c :d :e}})) | |
104 (is (= (get-neighbors cg #{:g}) | |
105 #{#{:a :b :c :d :e} #{:f}})) | |
106 (is (= (get-neighbors cg #{:i :j}) | |
107 #{#{:i :j}})) | |
108 (is (= (get-neighbors cg #{:h}) | |
109 #{})) | |
110 (is (= (apply max (map count (self-recursive-sets cg))) 1)) | |
111 (is (= ecg empty-graph)))) | |
112 | |
113 | |
114 (deftest test-recursive-component? | |
115 (let [sccs (scc test-graph-2)] | |
116 (is (= (set (filter (partial recursive-component? test-graph-2) sccs)) | |
117 #{#{:i :j} #{:b :c :a :d :e} #{:f}})))) | |
118 | |
119 | |
120 (deftest test-self-recursive-sets | |
121 (is (= (set (self-recursive-sets test-graph-2)) | |
122 (set (filter | |
123 (partial recursive-component? test-graph-2) | |
124 (scc test-graph-2))))) | |
125 (is (empty? (self-recursive-sets empty-graph)))) | |
126 | |
127 | |
128 (def test-graph-3 | |
129 (struct directed-graph | |
130 #{:a :b :c :d :e :f} | |
131 {:a #{:b} | |
132 :b #{:c} | |
133 :c #{:d} | |
134 :d #{:e} | |
135 :e #{:f} | |
136 :f #{}})) | |
137 | |
138 (def test-graph-4 | |
139 (struct directed-graph | |
140 #{:a :b :c :d :e :f :g :h} | |
141 {:a #{} | |
142 :b #{:a} | |
143 :c #{:a} | |
144 :d #{:a :b} | |
145 :e #{:d :c} | |
146 :f #{:e} | |
147 :g #{:d} | |
148 :h #{:f}})) | |
149 | |
150 (def test-graph-5 | |
151 (struct directed-graph | |
152 #{:a :b :c :d :e :f :g :h} | |
153 {:a #{} | |
154 :b #{} | |
155 :c #{:b} | |
156 :d #{} | |
157 :e #{} | |
158 :f #{} | |
159 :g #{:f} | |
160 :h #{}})) | |
161 | |
162 (deftest test-dependency-list | |
163 (is (thrown-with-msg? Exception #".*Fixed point overflow.*" | |
164 (dependency-list test-graph-2))) | |
165 (is (= (dependency-list test-graph-3) | |
166 [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}])) | |
167 (is (= (dependency-list test-graph-4) | |
168 [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}])) | |
169 (is (= (dependency-list test-graph-5) | |
170 [#{:f :b :a :d :h :e} #{:g :c}])) | |
171 (is (= (dependency-list empty-graph) | |
172 [#{}]))) | |
173 | |
174 (deftest test-stratification-list | |
175 (is (thrown-with-msg? Exception #".*Fixed point overflow.*" | |
176 (stratification-list test-graph-2 test-graph-2))) | |
177 (is (= (stratification-list test-graph-4 test-graph-5) | |
178 [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}])) | |
179 (is (= (stratification-list empty-graph empty-graph) | |
180 [#{}]))) | |
181 | |
182 (comment | |
183 (run-tests) | |
184 ) | |
185 | |
186 | |
187 ;; End of file |