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