Mercurial > lasercutter
comparison src/clojure/contrib/test_contrib/datalog/tests/test_rules.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-rules.clj | |
10 ;; | |
11 ;; A Clojure implementation of Datalog -- Rule Tests | |
12 ;; | |
13 ;; straszheimjeffrey (gmail) | |
14 ;; Created 12 Feburary 2009 | |
15 | |
16 | |
17 (ns clojure.contrib.datalog.tests.test-rules | |
18 (:use clojure.test | |
19 clojure.contrib.datalog.rules | |
20 clojure.contrib.datalog.literals | |
21 clojure.contrib.datalog.database)) | |
22 | |
23 | |
24 (def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y))) | |
25 (def tr-2 (<- (:fred) (not! :mary :x 3))) | |
26 (def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y))) | |
27 | |
28 | |
29 | |
30 (deftest test-rule-safety | |
31 (is (thrown-with-msg? Exception #".*Head vars.*not bound.*" | |
32 (<- (:fred :x ?x) (:sally :y ?y)))) | |
33 (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" | |
34 (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y)))) | |
35 (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" | |
36 (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y))))) | |
37 | |
38 | |
39 (deftest test-sip | |
40 (is (= (compute-sip #{:x} #{:mary :sally} tr-1) | |
41 (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) | |
42 ({:pred :mary :bound #{:x}} :z ?z :x ?x) | |
43 ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) | |
44 | |
45 (is (= (compute-sip #{} #{:mary :sally} tr-1) | |
46 (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) | |
47 | |
48 (is (= (compute-sip #{} #{:mary} tr-2) | |
49 (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3)))) | |
50 | |
51 (is (= (compute-sip #{} #{} tr-2) | |
52 tr-2)) | |
53 | |
54 (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3)) | |
55 (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) | |
56 ({:pred :mary :bound #{:x}} :x ?x) | |
57 (:sally :y ?y) | |
58 (if > ?x ?y)))))) | |
59 ; Display rule is used because = does not work on | |
60 ; (if > ?x ?y) because it contains a closure | |
61 | |
62 | |
63 (def rs | |
64 (rules-set | |
65 (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) | |
66 (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)) | |
67 (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y)))) | |
68 | |
69 (deftest test-rules-set | |
70 (is (= (count rs) 3)) | |
71 (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))))) | |
72 | |
73 (deftest test-predicate-map | |
74 (let [pm (predicate-map rs)] | |
75 (is (= (pm :path) | |
76 #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) | |
77 (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))})) | |
78 (is (= (-> :edge pm count) 1)))) | |
79 | |
80 | |
81 (def db1 (make-database | |
82 (relation :fred [:x :y]) | |
83 (index :fred :x) | |
84 (relation :sally [:x]) | |
85 (relation :ben [:y]))) | |
86 | |
87 (def db2 (add-tuples db1 | |
88 [:fred :x 1 :y :mary] | |
89 [:fred :x 1 :y :becky] | |
90 [:fred :x 3 :y :sally] | |
91 [:fred :x 4 :y :joe] | |
92 [:fred :x 4 :y :bob] | |
93 [:sally :x 1] | |
94 [:sally :x 2] | |
95 [:sally :x 3] | |
96 [:sally :x 4] | |
97 [:ben :y :bob])) | |
98 | |
99 | |
100 (deftest test-apply-rule | |
101 (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x) | |
102 (:fred :x ?x :y ?y) | |
103 (not! :ben :y ?y) | |
104 (if not= ?x 3))) | |
105 (datalog-database | |
106 { | |
107 :becky | |
108 (datalog-relation | |
109 ;; Schema | |
110 #{:y} | |
111 ;; Data | |
112 #{ | |
113 {:y :joe} | |
114 {:y :mary} | |
115 {:y :becky} | |
116 } | |
117 ;; Indexes | |
118 { | |
119 }) | |
120 })))) | |
121 | |
122 | |
123 | |
124 | |
125 (comment | |
126 (run-tests) | |
127 ) | |
128 | |
129 ;; End of file | |
130 |