Mercurial > lasercutter
comparison src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.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-softstrat.clj | |
10 ;; | |
11 ;; A Clojure implementation of Datalog -- Soft Stratification Tests | |
12 ;; | |
13 ;; straszheimjeffrey (gmail) | |
14 ;; Created 28 Feburary 2009 | |
15 | |
16 (ns clojure.contrib.datalog.tests.test-softstrat | |
17 (:use clojure.test) | |
18 (:use clojure.contrib.datalog.softstrat | |
19 clojure.contrib.datalog.magic | |
20 clojure.contrib.datalog.rules | |
21 clojure.contrib.datalog.database) | |
22 (:use [clojure.contrib.set :only (subset?)])) | |
23 | |
24 | |
25 | |
26 (def rs1 (rules-set | |
27 (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z)) | |
28 (<- (:q :x ?x) (:d :x ?x)))) | |
29 | |
30 (def q1 (?- :p :x 1)) | |
31 | |
32 (def ws (build-soft-strat-work-plan rs1 q1)) | |
33 | |
34 (deftest test-soft-stratification | |
35 (let [soft (:stratification ws) | |
36 q (:query ws)] | |
37 (is (= q (?- {:pred :p :bound #{:x}} :x 1))) | |
38 (is (= (count soft) 4)) | |
39 (is (subset? (rules-set | |
40 (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x) | |
41 (:d :x ?x)) | |
42 | |
43 (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) | |
44 (:b :z ?z :y ?y :x ?x))) | |
45 (nth soft 0))) | |
46 (is (= (nth soft 1) | |
47 (rules-set | |
48 (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x) | |
49 (:b :z ?z :y ?y :x ?x) | |
50 (not! {:pred :q :bound #{:x}} :x ?x))))) | |
51 (is (= (nth soft 2) | |
52 (rules-set | |
53 (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) | |
54 (:b :z ?z :y ?y :x ?x) | |
55 (not! {:pred :q :bound #{:x}} :x ?x) | |
56 (not! {:pred :q :bound #{:x}} :x ?y))))) | |
57 (is (= (nth soft 3) | |
58 (rules-set | |
59 (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) | |
60 (:b :z ?z :y ?y :x ?x) | |
61 (not! {:pred :q :bound #{:x}} :x ?x) | |
62 (not! {:pred :q :bound #{:x}} :x ?y) | |
63 (not! {:pred :q :bound #{:x}} :x ?z))))))) | |
64 | |
65 | |
66 (def tdb-1 | |
67 (make-database | |
68 (relation :b [:x :y :z]) | |
69 (relation :d [:x]))) | |
70 | |
71 (def tdb-2 | |
72 (add-tuples tdb-1 | |
73 [:b :x 1 :y 2 :z 3])) | |
74 | |
75 (deftest test-tdb-2 | |
76 (is (= (evaluate-soft-work-set ws tdb-2 {}) | |
77 [{:x 1}]))) | |
78 | |
79 | |
80 | |
81 (def tdb-3 | |
82 (add-tuples tdb-2 | |
83 [:d :x 2] | |
84 [:d :x 3])) | |
85 | |
86 (deftest test-tdb-3 | |
87 (is (empty? (evaluate-soft-work-set ws tdb-3 {})))) | |
88 | |
89 | |
90 | |
91 ;;;;;;;;;;; | |
92 | |
93 | |
94 | |
95 (def db-base | |
96 (make-database | |
97 (relation :employee [:id :name :position]) | |
98 (index :employee :name) | |
99 | |
100 (relation :boss [:employee-id :boss-id]) | |
101 (index :boss :employee-id) | |
102 | |
103 (relation :can-do-job [:position :job]) | |
104 (index :can-do-job :position) | |
105 | |
106 (relation :job-replacement [:job :can-be-done-by]) | |
107 | |
108 (relation :job-exceptions [:id :job]))) | |
109 | |
110 (def db | |
111 (add-tuples db-base | |
112 [:employee :id 1 :name "Bob" :position :boss] | |
113 [:employee :id 2 :name "Mary" :position :chief-accountant] | |
114 [:employee :id 3 :name "John" :position :accountant] | |
115 [:employee :id 4 :name "Sameer" :position :chief-programmer] | |
116 [:employee :id 5 :name "Lilian" :position :programmer] | |
117 [:employee :id 6 :name "Li" :position :technician] | |
118 [:employee :id 7 :name "Fred" :position :sales] | |
119 [:employee :id 8 :name "Brenda" :position :sales] | |
120 [:employee :id 9 :name "Miki" :position :project-management] | |
121 [:employee :id 10 :name "Albert" :position :technician] | |
122 | |
123 [:boss :employee-id 2 :boss-id 1] | |
124 [:boss :employee-id 3 :boss-id 2] | |
125 [:boss :employee-id 4 :boss-id 1] | |
126 [:boss :employee-id 5 :boss-id 4] | |
127 [:boss :employee-id 6 :boss-id 4] | |
128 [:boss :employee-id 7 :boss-id 1] | |
129 [:boss :employee-id 8 :boss-id 7] | |
130 [:boss :employee-id 9 :boss-id 1] | |
131 [:boss :employee-id 10 :boss-id 6] | |
132 | |
133 [:can-do-job :position :boss :job :management] | |
134 [:can-do-job :position :accountant :job :accounting] | |
135 [:can-do-job :position :chief-accountant :job :accounting] | |
136 [:can-do-job :position :programmer :job :programming] | |
137 [:can-do-job :position :chief-programmer :job :programming] | |
138 [:can-do-job :position :technician :job :server-support] | |
139 [:can-do-job :position :sales :job :sales] | |
140 [:can-do-job :position :project-management :job :project-management] | |
141 | |
142 [:job-replacement :job :pc-support :can-be-done-by :server-support] | |
143 [:job-replacement :job :pc-support :can-be-done-by :programming] | |
144 [:job-replacement :job :payroll :can-be-done-by :accounting] | |
145 | |
146 [:job-exceptions :id 4 :job :pc-support])) | |
147 | |
148 (def rules | |
149 (rules-set | |
150 (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) | |
151 (:employee :id ?e-id :name ?x) | |
152 (:employee :id ?b-id :name ?y)) | |
153 (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) | |
154 (:works-for :employee ?z :boss ?y)) | |
155 (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) | |
156 (:can-do-job :position ?pos :job ?y)) | |
157 (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) | |
158 (:employee-job* :employee ?x :job ?z)) | |
159 (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) | |
160 (:employee :name ?x :position ?z) | |
161 (if = ?z :boss)) | |
162 (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) | |
163 (:employee :id ?id :name ?x) | |
164 (not! :job-exceptions :id ?id :job ?y)) | |
165 (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) | |
166 (not! :employee-job :employee ?y :job :pc-support)))) | |
167 | |
168 | |
169 (def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x))) | |
170 (defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name}))) | |
171 | |
172 (deftest test-ws-1 | |
173 (is (= (evaluate-1 "Albert") | |
174 #{{:employee "Albert", :boss "Li"} | |
175 {:employee "Albert", :boss "Sameer"} | |
176 {:employee "Albert", :boss "Bob"}})) | |
177 (is (empty? (evaluate-1 "Bob"))) | |
178 (is (= (evaluate-1 "John") | |
179 #{{:employee "John", :boss "Bob"} | |
180 {:employee "John", :boss "Mary"}}))) | |
181 | |
182 | |
183 (def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x))) | |
184 (defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name}))) | |
185 | |
186 (deftest test-ws-2 | |
187 (is (= (evaluate-2 "Albert") | |
188 #{{:employee "Albert", :job :pc-support} | |
189 {:employee "Albert", :job :server-support}})) | |
190 (is (= (evaluate-2 "Sameer") | |
191 #{{:employee "Sameer", :job :programming}})) | |
192 (is (= (evaluate-2 "Bob") | |
193 #{{:employee "Bob", :job :accounting} | |
194 {:employee "Bob", :job :management} | |
195 {:employee "Bob", :job :payroll} | |
196 {:employee "Bob", :job :pc-support} | |
197 {:employee "Bob", :job :project-management} | |
198 {:employee "Bob", :job :programming} | |
199 {:employee "Bob", :job :server-support} | |
200 {:employee "Bob", :job :sales}}))) | |
201 | |
202 (def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x))) | |
203 (defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name}))) | |
204 | |
205 (deftest test-ws-3 | |
206 (is (= (evaluate-3 "Albert") | |
207 #{{:name "Albert", :boss "Sameer"}}))) | |
208 | |
209 (def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x))) | |
210 | |
211 (deftest test-ws-4 | |
212 (is (= (set (evaluate-soft-work-set ws-4 db {})) | |
213 #{{:employee "Miki", :boss "Bob"} | |
214 {:employee "Albert", :boss "Li"} | |
215 {:employee "Lilian", :boss "Sameer"} | |
216 {:employee "Li", :boss "Bob"} | |
217 {:employee "Lilian", :boss "Bob"} | |
218 {:employee "Brenda", :boss "Fred"} | |
219 {:employee "Fred", :boss "Bob"} | |
220 {:employee "John", :boss "Bob"} | |
221 {:employee "John", :boss "Mary"} | |
222 {:employee "Albert", :boss "Sameer"} | |
223 {:employee "Sameer", :boss "Bob"} | |
224 {:employee "Albert", :boss "Bob"} | |
225 {:employee "Brenda", :boss "Bob"} | |
226 {:employee "Mary", :boss "Bob"} | |
227 {:employee "Li", :boss "Sameer"}}))) | |
228 | |
229 (comment | |
230 (run-tests) | |
231 ) | |
232 | |
233 ;; End of file |