1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_rules.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,130 @@
     1.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  test-rules.clj
    1.13 +;;
    1.14 +;;  A Clojure implementation of Datalog -- Rule Tests
    1.15 +;;
    1.16 +;;  straszheimjeffrey (gmail)
    1.17 +;;  Created 12 Feburary 2009
    1.18 +
    1.19 +
    1.20 +(ns clojure.contrib.datalog.tests.test-rules
    1.21 +  (:use clojure.test
    1.22 +        clojure.contrib.datalog.rules
    1.23 +        clojure.contrib.datalog.literals
    1.24 +        clojure.contrib.datalog.database))
    1.25 +
    1.26 +
    1.27 +(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y)))
    1.28 +(def tr-2 (<- (:fred) (not! :mary :x 3)))
    1.29 +(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y)))
    1.30 +
    1.31 +
    1.32 +
    1.33 +(deftest test-rule-safety
    1.34 +  (is (thrown-with-msg? Exception #".*Head vars.*not bound.*"
    1.35 +         (<- (:fred :x ?x) (:sally :y ?y))))
    1.36 +  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
    1.37 +         (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y))))
    1.38 +  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
    1.39 +         (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y)))))
    1.40 +
    1.41 +
    1.42 +(deftest test-sip
    1.43 +  (is (= (compute-sip #{:x} #{:mary :sally} tr-1)
    1.44 +         (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
    1.45 +                      ({:pred :mary :bound #{:x}} :z ?z :x ?x)
    1.46 +                      ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
    1.47 +
    1.48 +  (is (= (compute-sip #{} #{:mary :sally} tr-1)
    1.49 +         (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
    1.50 +
    1.51 +  (is (= (compute-sip #{} #{:mary} tr-2)
    1.52 +         (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))
    1.53 +  
    1.54 +  (is (= (compute-sip #{} #{} tr-2)
    1.55 +         tr-2))
    1.56 +
    1.57 +  (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))
    1.58 +         (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
    1.59 +                               ({:pred :mary :bound #{:x}} :x ?x)
    1.60 +                               (:sally :y ?y)
    1.61 +                               (if > ?x ?y))))))
    1.62 +                   ; Display rule is used because = does not work on
    1.63 +                   ; (if > ?x ?y) because it contains a closure
    1.64 +
    1.65 +
    1.66 +(def rs
    1.67 +     (rules-set
    1.68 +        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
    1.69 +        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))
    1.70 +        (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y))))
    1.71 +
    1.72 +(deftest test-rules-set
    1.73 +  (is (= (count rs) 3))
    1.74 +  (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)))))
    1.75 +  
    1.76 +(deftest test-predicate-map
    1.77 +  (let [pm (predicate-map rs)]
    1.78 +    (is (= (pm :path)
    1.79 +           #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
    1.80 +             (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))}))
    1.81 +    (is (= (-> :edge pm count) 1))))
    1.82 +
    1.83 +
    1.84 +(def db1 (make-database
    1.85 +           (relation :fred [:x :y])
    1.86 +           (index :fred :x)
    1.87 +           (relation :sally [:x])
    1.88 +           (relation :ben [:y])))
    1.89 +
    1.90 +(def db2 (add-tuples db1
    1.91 +             [:fred :x 1 :y :mary]
    1.92 +             [:fred :x 1 :y :becky]
    1.93 +             [:fred :x 3 :y :sally]
    1.94 +             [:fred :x 4 :y :joe]
    1.95 +             [:fred :x 4 :y :bob]
    1.96 +             [:sally :x 1]
    1.97 +             [:sally :x 2]
    1.98 +             [:sally :x 3]
    1.99 +             [:sally :x 4]
   1.100 +             [:ben :y :bob]))
   1.101 +
   1.102 +
   1.103 +(deftest test-apply-rule
   1.104 +  (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x)
   1.105 +                                                           (:fred :x ?x :y ?y)
   1.106 +                                                           (not! :ben :y ?y)
   1.107 +                                                           (if not= ?x 3)))
   1.108 +         (datalog-database
   1.109 +          {
   1.110 +           :becky
   1.111 +           (datalog-relation
   1.112 +            ;; Schema
   1.113 +            #{:y}
   1.114 +            ;; Data
   1.115 +            #{
   1.116 +              {:y :joe}
   1.117 +              {:y :mary}
   1.118 +              {:y :becky}
   1.119 +              }
   1.120 +            ;; Indexes
   1.121 +            {
   1.122 +             })
   1.123 +           }))))
   1.124 +
   1.125 +
   1.126 +
   1.127 +
   1.128 +(comment
   1.129 +  (run-tests)
   1.130 +)
   1.131 +
   1.132 +;; End of file
   1.133 +