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