|
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-literals.clj
|
|
rlm@10
|
10 ;;
|
|
rlm@10
|
11 ;; A Clojure implementation of Datalog -- Literals tests
|
|
rlm@10
|
12 ;;
|
|
rlm@10
|
13 ;; straszheimjeffrey (gmail)
|
|
rlm@10
|
14 ;; Created 25 Feburary 2009
|
|
rlm@10
|
15
|
|
rlm@10
|
16
|
|
rlm@10
|
17 (ns clojure.contrib.datalog.tests.test-literals
|
|
rlm@10
|
18 (:use clojure.test)
|
|
rlm@10
|
19 (:use clojure.contrib.datalog.literals
|
|
rlm@10
|
20 clojure.contrib.datalog.database))
|
|
rlm@10
|
21
|
|
rlm@10
|
22
|
|
rlm@10
|
23 (def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3))))
|
|
rlm@10
|
24 (def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3))))
|
|
rlm@10
|
25 (def cl (eval (build-literal '(if > ?x 3))))
|
|
rlm@10
|
26
|
|
rlm@10
|
27 (def bl (eval (build-literal '(:fred))))
|
|
rlm@10
|
28
|
|
rlm@10
|
29 (def bns {:x '?x :y '?y :z 3})
|
|
rlm@10
|
30
|
|
rlm@10
|
31 (deftest test-build-literal
|
|
rlm@10
|
32 (is (= (:predicate pl) :fred))
|
|
rlm@10
|
33 (is (= (:term-bindings pl) bns))
|
|
rlm@10
|
34 (is (= (:predicate nl) :fred))
|
|
rlm@10
|
35 (is (= (:term-bindings nl) bns))
|
|
rlm@10
|
36 (is (= (:symbol cl) '>))
|
|
rlm@10
|
37 (is (= (:terms cl) '(?x 3)))
|
|
rlm@10
|
38 (is ((:fun cl) [4 3]))
|
|
rlm@10
|
39 (is (not ((:fun cl) [2 4])))
|
|
rlm@10
|
40 (is (= (:predicate bl) :fred)))
|
|
rlm@10
|
41
|
|
rlm@10
|
42 (deftest test-literal-predicate
|
|
rlm@10
|
43 (is (= (literal-predicate pl) :fred))
|
|
rlm@10
|
44 (is (= (literal-predicate nl) :fred))
|
|
rlm@10
|
45 (is (nil? (literal-predicate cl)))
|
|
rlm@10
|
46 (is (= (literal-predicate bl) :fred)))
|
|
rlm@10
|
47
|
|
rlm@10
|
48 (deftest test-literal-columns
|
|
rlm@10
|
49 (is (= (literal-columns pl) #{:x :y :z}))
|
|
rlm@10
|
50 (is (= (literal-columns nl) #{:x :y :z}))
|
|
rlm@10
|
51 (is (nil? (literal-columns cl)))
|
|
rlm@10
|
52 (is (empty? (literal-columns bl))))
|
|
rlm@10
|
53
|
|
rlm@10
|
54 (deftest test-literal-vars
|
|
rlm@10
|
55 (is (= (literal-vars pl) #{'?x '?y}))
|
|
rlm@10
|
56 (is (= (literal-vars nl) #{'?x '?y}))
|
|
rlm@10
|
57 (is (= (literal-vars cl) #{'?x}))
|
|
rlm@10
|
58 (is (empty? (literal-vars bl))))
|
|
rlm@10
|
59
|
|
rlm@10
|
60 (deftest test-positive-vars
|
|
rlm@10
|
61 (is (= (positive-vars pl) (literal-vars pl)))
|
|
rlm@10
|
62 (is (nil? (positive-vars nl)))
|
|
rlm@10
|
63 (is (nil? (positive-vars cl)))
|
|
rlm@10
|
64 (is (empty? (positive-vars bl))))
|
|
rlm@10
|
65
|
|
rlm@10
|
66 (deftest test-negative-vars
|
|
rlm@10
|
67 (is (nil? (negative-vars pl)))
|
|
rlm@10
|
68 (is (= (negative-vars nl) (literal-vars nl)))
|
|
rlm@10
|
69 (is (= (negative-vars cl) (literal-vars cl)))
|
|
rlm@10
|
70 (is (empty? (negative-vars bl))))
|
|
rlm@10
|
71
|
|
rlm@10
|
72 (deftest test-negated?
|
|
rlm@10
|
73 (is (not (negated? pl)))
|
|
rlm@10
|
74 (is (negated? nl))
|
|
rlm@10
|
75 (is (not (negated? cl))))
|
|
rlm@10
|
76
|
|
rlm@10
|
77 (deftest test-vs-from-cs
|
|
rlm@10
|
78 (is (= (get-vs-from-cs pl #{:x}) #{'?x}))
|
|
rlm@10
|
79 (is (empty? (get-vs-from-cs pl #{:z})))
|
|
rlm@10
|
80 (is (= (get-vs-from-cs pl #{:x :r}) #{'?x}))
|
|
rlm@10
|
81 (is (empty? (get-vs-from-cs pl #{}))))
|
|
rlm@10
|
82
|
|
rlm@10
|
83 (deftest test-cs-from-vs
|
|
rlm@10
|
84 (is (= (get-cs-from-vs pl #{'?x}) #{:x}))
|
|
rlm@10
|
85 (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x}))
|
|
rlm@10
|
86 (is (empty? (get-cs-from-vs pl #{}))))
|
|
rlm@10
|
87
|
|
rlm@10
|
88 (deftest test-literal-appropriate?
|
|
rlm@10
|
89 (is (not (literal-appropriate? #{} pl)))
|
|
rlm@10
|
90 (is (literal-appropriate? #{'?x} pl))
|
|
rlm@10
|
91 (is (not (literal-appropriate? #{'?x} nl)))
|
|
rlm@10
|
92 (is (literal-appropriate? #{'?x '?y} nl))
|
|
rlm@10
|
93 (is (not (literal-appropriate? #{'?z} cl)))
|
|
rlm@10
|
94 (is (literal-appropriate? #{'?x} cl)))
|
|
rlm@10
|
95
|
|
rlm@10
|
96 (deftest test-adorned-literal
|
|
rlm@10
|
97 (is (= (literal-predicate (adorned-literal pl #{:x}))
|
|
rlm@10
|
98 {:pred :fred :bound #{:x}}))
|
|
rlm@10
|
99 (is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
|
|
rlm@10
|
100 {:pred :fred :bound #{:x :y}}))
|
|
rlm@10
|
101 (is (= (:term-bindings (adorned-literal nl #{:x}))
|
|
rlm@10
|
102 {:x '?x :y '?y :z 3}))
|
|
rlm@10
|
103 (is (= (adorned-literal cl #{})
|
|
rlm@10
|
104 cl)))
|
|
rlm@10
|
105
|
|
rlm@10
|
106 (deftest test-get-adorned-bindings
|
|
rlm@10
|
107 (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x})))
|
|
rlm@10
|
108 #{:x}))
|
|
rlm@10
|
109 (is (= (get-adorned-bindings (literal-predicate pl))
|
|
rlm@10
|
110 nil)))
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (deftest test-get-base-predicate
|
|
rlm@10
|
113 (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x})))
|
|
rlm@10
|
114 :fred))
|
|
rlm@10
|
115 (is (= (get-base-predicate (literal-predicate pl))
|
|
rlm@10
|
116 :fred)))
|
|
rlm@10
|
117
|
|
rlm@10
|
118 (deftest test-magic-literal
|
|
rlm@10
|
119 (is (= (magic-literal pl)
|
|
rlm@10
|
120 {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
|
|
rlm@10
|
121 (is (= (magic-literal (adorned-literal pl #{:x}))
|
|
rlm@10
|
122 {:predicate {:pred :fred :magic true :bound #{:x}},
|
|
rlm@10
|
123 :term-bindings {:x '?x},
|
|
rlm@10
|
124 :literal-type :clojure.contrib.datalog.literals/literal})))
|
|
rlm@10
|
125
|
|
rlm@10
|
126 (comment
|
|
rlm@10
|
127 (use 'clojure.contrib.stacktrace) (e)
|
|
rlm@10
|
128 (use :reload 'clojure.contrib.datalog.literals)
|
|
rlm@10
|
129 )
|
|
rlm@10
|
130
|
|
rlm@10
|
131
|
|
rlm@10
|
132 (def db1 (make-database
|
|
rlm@10
|
133 (relation :fred [:x :y])
|
|
rlm@10
|
134 (index :fred :x)
|
|
rlm@10
|
135 (relation :sally [:x])))
|
|
rlm@10
|
136
|
|
rlm@10
|
137 (def db2 (add-tuples db1
|
|
rlm@10
|
138 [:fred :x 1 :y :mary]
|
|
rlm@10
|
139 [:fred :x 1 :y :becky]
|
|
rlm@10
|
140 [:fred :x 3 :y :sally]
|
|
rlm@10
|
141 [:fred :x 4 :y :joe]
|
|
rlm@10
|
142 [:sally :x 1]
|
|
rlm@10
|
143 [:sally :x 2]))
|
|
rlm@10
|
144
|
|
rlm@10
|
145 (def lit1 (eval (build-literal '(:fred :x ?x :y ?y))))
|
|
rlm@10
|
146 (def lit2 (eval (build-literal '(not! :fred :x ?x))))
|
|
rlm@10
|
147 (def lit3 (eval (build-literal '(if > ?x ?y))))
|
|
rlm@10
|
148 (def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x}))
|
|
rlm@10
|
149
|
|
rlm@10
|
150 (deftest test-join-literal
|
|
rlm@10
|
151 (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}]))
|
|
rlm@10
|
152 #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}}))
|
|
rlm@10
|
153 (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}])
|
|
rlm@10
|
154 [{'?x 2}]))
|
|
rlm@10
|
155 (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}])
|
|
rlm@10
|
156 [{'?x 3 '?y 1}])))
|
|
rlm@10
|
157
|
|
rlm@10
|
158 (deftest test-project-literal
|
|
rlm@10
|
159 (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}})
|
|
rlm@10
|
160 (datalog-relation
|
|
rlm@10
|
161 ;; Schema
|
|
rlm@10
|
162 #{:y :x}
|
|
rlm@10
|
163
|
|
rlm@10
|
164 ;; Data
|
|
rlm@10
|
165 #{
|
|
rlm@10
|
166 {:x 1, :y 3}
|
|
rlm@10
|
167 {:x 4, :y 2}
|
|
rlm@10
|
168 }
|
|
rlm@10
|
169
|
|
rlm@10
|
170 ;; Indexes
|
|
rlm@10
|
171 {
|
|
rlm@10
|
172 :x
|
|
rlm@10
|
173 {
|
|
rlm@10
|
174 4
|
|
rlm@10
|
175 #{{:x 4, :y 2}}
|
|
rlm@10
|
176 1
|
|
rlm@10
|
177 #{{:x 1, :y 3}}
|
|
rlm@10
|
178 }
|
|
rlm@10
|
179 }))))
|
|
rlm@10
|
180
|
|
rlm@10
|
181
|
|
rlm@10
|
182
|
|
rlm@10
|
183 (comment
|
|
rlm@10
|
184 (run-tests)
|
|
rlm@10
|
185 )
|
|
rlm@10
|
186
|
|
rlm@10
|
187 ;; End of file
|
