rlm@10: ;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
rlm@10: ;;  distribution terms for this software are covered by the Eclipse Public
rlm@10: ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10: ;;  be found in the file epl-v10.html at the root of this distribution.  By
rlm@10: ;;  using this software in any fashion, you are agreeing to be bound by the
rlm@10: ;;  terms of this license.  You must not remove this notice, or any other,
rlm@10: ;;  from this software.
rlm@10: ;;
rlm@10: ;;  test-rules.clj
rlm@10: ;;
rlm@10: ;;  A Clojure implementation of Datalog -- Rule Tests
rlm@10: ;;
rlm@10: ;;  straszheimjeffrey (gmail)
rlm@10: ;;  Created 12 Feburary 2009
rlm@10: 
rlm@10: 
rlm@10: (ns clojure.contrib.datalog.tests.test-rules
rlm@10:   (:use clojure.test
rlm@10:         clojure.contrib.datalog.rules
rlm@10:         clojure.contrib.datalog.literals
rlm@10:         clojure.contrib.datalog.database))
rlm@10: 
rlm@10: 
rlm@10: (def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y)))
rlm@10: (def tr-2 (<- (:fred) (not! :mary :x 3)))
rlm@10: (def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y)))
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: (deftest test-rule-safety
rlm@10:   (is (thrown-with-msg? Exception #".*Head vars.*not bound.*"
rlm@10:          (<- (:fred :x ?x) (:sally :y ?y))))
rlm@10:   (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
rlm@10:          (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y))))
rlm@10:   (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
rlm@10:          (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y)))))
rlm@10: 
rlm@10: 
rlm@10: (deftest test-sip
rlm@10:   (is (= (compute-sip #{:x} #{:mary :sally} tr-1)
rlm@10:          (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
rlm@10:                       ({:pred :mary :bound #{:x}} :z ?z :x ?x)
rlm@10:                       ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
rlm@10: 
rlm@10:   (is (= (compute-sip #{} #{:mary :sally} tr-1)
rlm@10:          (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
rlm@10: 
rlm@10:   (is (= (compute-sip #{} #{:mary} tr-2)
rlm@10:          (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))
rlm@10:   
rlm@10:   (is (= (compute-sip #{} #{} tr-2)
rlm@10:          tr-2))
rlm@10: 
rlm@10:   (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))
rlm@10:          (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
rlm@10:                                ({:pred :mary :bound #{:x}} :x ?x)
rlm@10:                                (:sally :y ?y)
rlm@10:                                (if > ?x ?y))))))
rlm@10:                    ; Display rule is used because = does not work on
rlm@10:                    ; (if > ?x ?y) because it contains a closure
rlm@10: 
rlm@10: 
rlm@10: (def rs
rlm@10:      (rules-set
rlm@10:         (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
rlm@10:         (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))
rlm@10:         (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y))))
rlm@10: 
rlm@10: (deftest test-rules-set
rlm@10:   (is (= (count rs) 3))
rlm@10:   (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)))))
rlm@10:   
rlm@10: (deftest test-predicate-map
rlm@10:   (let [pm (predicate-map rs)]
rlm@10:     (is (= (pm :path)
rlm@10:            #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
rlm@10:              (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))}))
rlm@10:     (is (= (-> :edge pm count) 1))))
rlm@10: 
rlm@10: 
rlm@10: (def db1 (make-database
rlm@10:            (relation :fred [:x :y])
rlm@10:            (index :fred :x)
rlm@10:            (relation :sally [:x])
rlm@10:            (relation :ben [:y])))
rlm@10: 
rlm@10: (def db2 (add-tuples db1
rlm@10:              [:fred :x 1 :y :mary]
rlm@10:              [:fred :x 1 :y :becky]
rlm@10:              [:fred :x 3 :y :sally]
rlm@10:              [:fred :x 4 :y :joe]
rlm@10:              [:fred :x 4 :y :bob]
rlm@10:              [:sally :x 1]
rlm@10:              [:sally :x 2]
rlm@10:              [:sally :x 3]
rlm@10:              [:sally :x 4]
rlm@10:              [:ben :y :bob]))
rlm@10: 
rlm@10: 
rlm@10: (deftest test-apply-rule
rlm@10:   (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x)
rlm@10:                                                            (:fred :x ?x :y ?y)
rlm@10:                                                            (not! :ben :y ?y)
rlm@10:                                                            (if not= ?x 3)))
rlm@10:          (datalog-database
rlm@10:           {
rlm@10:            :becky
rlm@10:            (datalog-relation
rlm@10:             ;; Schema
rlm@10:             #{:y}
rlm@10:             ;; Data
rlm@10:             #{
rlm@10:               {:y :joe}
rlm@10:               {:y :mary}
rlm@10:               {:y :becky}
rlm@10:               }
rlm@10:             ;; Indexes
rlm@10:             {
rlm@10:              })
rlm@10:            }))))
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: (comment
rlm@10:   (run-tests)
rlm@10: )
rlm@10: 
rlm@10: ;; End of file
rlm@10: