diff options
author | Stuart Sierra <mail@stuartsierra.com> | 2010-08-10 21:40:47 -0400 |
---|---|---|
committer | Stuart Sierra <mail@stuartsierra.com> | 2010-08-10 21:40:47 -0400 |
commit | 38743f83bdd60d6687dabcea3864b04bbd554a6c (patch) | |
tree | 44b31d4900c2d5720679abe911694d64fc516d0a /modules/datalog/src | |
parent | a6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 (diff) |
Add test sources to their respective modules
Diffstat (limited to 'modules/datalog/src')
7 files changed, 889 insertions, 0 deletions
diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj new file mode 100644 index 00000000..121d264e --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj @@ -0,0 +1,45 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test.clj +;; +;; A Clojure implementation of Datalog -- Tests +;; +;; straszheimjeffrey (gmail) +;; Created 11 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test + (:use [clojure.test :only (run-tests)]) + (:gen-class)) + +(def test-names [:test-util + :test-database + :test-literals + :test-rules + :test-magic + :test-softstrat]) + +(def test-namespaces + (map #(symbol (str "clojure.contrib.datalog.tests." (name %))) + test-names)) + +(defn run + "Runs all defined tests" + [] + (println "Loading tests...") + (apply require :reload-all test-namespaces) + (apply run-tests test-namespaces)) + +(defn -main + "Run all defined tests from the command line" + [& args] + (run) + (System/exit 0)) + + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj new file mode 100644 index 00000000..77719008 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj @@ -0,0 +1,153 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-database.clj +;; +;; A Clojure implementation of Datalog -- Database +;; +;; straszheimjeffrey (gmail) +;; Created 12 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-database + (:use clojure.test + clojure.contrib.datalog.database)) + + +(def test-db + (make-database + (relation :fred [:mary :sue]) + (index :fred :mary) + (relation :sally [:jen :becky :joan]) + (index :sally :jen) + (index :sally :becky))) + +(deftest test-make-database + (is (= test-db + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{} + {:becky {} + :jen {}}) + :fred (datalog-relation + #{:sue :mary} + #{} + {:mary {}})})))) + + +(deftest test-ensure-relation + (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob)) + (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred)) + (is (thrown? AssertionError (ensure-relation test-db :fred [:bob :joe] [])))) + +(deftest test-add-tuple + (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})] + (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}]))) + (is (thrown? AssertionError (add-tuple test-db :fred {:mary 1})))) + +(def test-db-1 + (add-tuples test-db + [:fred :mary 1 :sue 2] + [:fred :mary 2 :sue 3] + [:sally :jen 1 :becky 2 :joan 0] + [:sally :jen 1 :becky 4 :joan 3] + [:sally :jen 1 :becky 3 :joan 0] + [:sally :jen 1 :becky 2 :joan 3] + [:fred :mary 1 :sue 1] + [:fred :mary 3 :sue 1])) + +(deftest test-add-tuples + (is (= test-db-1 + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2} + {:jen 1, :joan 3, :becky 4}} + {:becky {3 + #{{:jen 1, :joan 0, :becky 3}} + 4 + #{{:jen 1, :joan 3, :becky 4}} + 2 + #{{:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2}}} + :jen {1 + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2} + {:jen 1, :joan 3, :becky 4}}}}) + :fred (datalog-relation + #{:sue :mary} + #{{:sue 2, :mary 1} + {:sue 1, :mary 1} + {:sue 3, :mary 2} + {:sue 1, :mary 3}} + {:mary {3 + #{{:sue 1, :mary 3}} + 2 + #{{:sue 3, :mary 2}} + 1 + #{{:sue 2, :mary 1} + {:sue 1, :mary 1}}}})})))) + +(deftest test-remove-tuples + (let [db (reduce #(apply remove-tuple %1 (first %2) (next %2)) + test-db-1 + [[:fred {:mary 1 :sue 1}] + [:fred {:mary 3 :sue 1}] + [:sally {:jen 1 :becky 2 :joan 0}] + [:sally {:jen 1 :becky 4 :joan 3}]])] + (is (= db + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 3, :becky 2}} + {:becky + {3 + #{{:jen 1, :joan 0, :becky 3}} + 2 + #{{:jen 1, :joan 3, :becky 2}}} + :jen + {1 + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 3, :becky 2}}}}) + :fred (datalog-relation + #{:sue :mary} + #{{:sue 2, :mary 1} + {:sue 3, :mary 2}} + {:mary + {2 + #{{:sue 3, :mary 2}} + 1 + #{{:sue 2, :mary 1}}}})}))))) + + + +(deftest test-select + (is (= (set (select test-db-1 :sally {:jen 1 :becky 2})) + #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}})) + (is (= (set (select test-db-1 :fred {:sue 1}))) + #{{:mary 3 :sue 1} {:mary 1 :sue 1}}) + (is (empty? (select test-db-1 :sally {:joan 5 :jen 1})))) + +(deftest test-any-match? + (is (any-match? test-db-1 :fred {:mary 3})) + (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3})) + (is (not (any-match? test-db-1 :sally {:jen 5}))) + (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5})))) + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj new file mode 100644 index 00000000..36ee5147 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj @@ -0,0 +1,187 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-literals.clj +;; +;; A Clojure implementation of Datalog -- Literals tests +;; +;; straszheimjeffrey (gmail) +;; Created 25 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-literals + (:use clojure.test) + (:use clojure.contrib.datalog.literals + clojure.contrib.datalog.database)) + + +(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3)))) +(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3)))) +(def cl (eval (build-literal '(if > ?x 3)))) + +(def bl (eval (build-literal '(:fred)))) + +(def bns {:x '?x :y '?y :z 3}) + +(deftest test-build-literal + (is (= (:predicate pl) :fred)) + (is (= (:term-bindings pl) bns)) + (is (= (:predicate nl) :fred)) + (is (= (:term-bindings nl) bns)) + (is (= (:symbol cl) '>)) + (is (= (:terms cl) '(?x 3))) + (is ((:fun cl) [4 3])) + (is (not ((:fun cl) [2 4]))) + (is (= (:predicate bl) :fred))) + +(deftest test-literal-predicate + (is (= (literal-predicate pl) :fred)) + (is (= (literal-predicate nl) :fred)) + (is (nil? (literal-predicate cl))) + (is (= (literal-predicate bl) :fred))) + +(deftest test-literal-columns + (is (= (literal-columns pl) #{:x :y :z})) + (is (= (literal-columns nl) #{:x :y :z})) + (is (nil? (literal-columns cl))) + (is (empty? (literal-columns bl)))) + +(deftest test-literal-vars + (is (= (literal-vars pl) #{'?x '?y})) + (is (= (literal-vars nl) #{'?x '?y})) + (is (= (literal-vars cl) #{'?x})) + (is (empty? (literal-vars bl)))) + +(deftest test-positive-vars + (is (= (positive-vars pl) (literal-vars pl))) + (is (nil? (positive-vars nl))) + (is (nil? (positive-vars cl))) + (is (empty? (positive-vars bl)))) + +(deftest test-negative-vars + (is (nil? (negative-vars pl))) + (is (= (negative-vars nl) (literal-vars nl))) + (is (= (negative-vars cl) (literal-vars cl))) + (is (empty? (negative-vars bl)))) + +(deftest test-negated? + (is (not (negated? pl))) + (is (negated? nl)) + (is (not (negated? cl)))) + +(deftest test-vs-from-cs + (is (= (get-vs-from-cs pl #{:x}) #{'?x})) + (is (empty? (get-vs-from-cs pl #{:z}))) + (is (= (get-vs-from-cs pl #{:x :r}) #{'?x})) + (is (empty? (get-vs-from-cs pl #{})))) + +(deftest test-cs-from-vs + (is (= (get-cs-from-vs pl #{'?x}) #{:x})) + (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x})) + (is (empty? (get-cs-from-vs pl #{})))) + +(deftest test-literal-appropriate? + (is (not (literal-appropriate? #{} pl))) + (is (literal-appropriate? #{'?x} pl)) + (is (not (literal-appropriate? #{'?x} nl))) + (is (literal-appropriate? #{'?x '?y} nl)) + (is (not (literal-appropriate? #{'?z} cl))) + (is (literal-appropriate? #{'?x} cl))) + +(deftest test-adorned-literal + (is (= (literal-predicate (adorned-literal pl #{:x})) + {:pred :fred :bound #{:x}})) + (is (= (literal-predicate (adorned-literal nl #{:x :y :q})) + {:pred :fred :bound #{:x :y}})) + (is (= (:term-bindings (adorned-literal nl #{:x})) + {:x '?x :y '?y :z 3})) + (is (= (adorned-literal cl #{}) + cl))) + +(deftest test-get-adorned-bindings + (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x}))) + #{:x})) + (is (= (get-adorned-bindings (literal-predicate pl)) + nil))) + +(deftest test-get-base-predicate + (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x}))) + :fred)) + (is (= (get-base-predicate (literal-predicate pl)) + :fred))) + +(deftest test-magic-literal + (is (= (magic-literal pl) + {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal})) + (is (= (magic-literal (adorned-literal pl #{:x})) + {:predicate {:pred :fred :magic true :bound #{:x}}, + :term-bindings {:x '?x}, + :literal-type :clojure.contrib.datalog.literals/literal}))) + +(comment + (use 'clojure.contrib.stacktrace) (e) + (use :reload 'clojure.contrib.datalog.literals) +) + + +(def db1 (make-database + (relation :fred [:x :y]) + (index :fred :x) + (relation :sally [:x]))) + +(def db2 (add-tuples db1 + [:fred :x 1 :y :mary] + [:fred :x 1 :y :becky] + [:fred :x 3 :y :sally] + [:fred :x 4 :y :joe] + [:sally :x 1] + [:sally :x 2])) + +(def lit1 (eval (build-literal '(:fred :x ?x :y ?y)))) +(def lit2 (eval (build-literal '(not! :fred :x ?x)))) +(def lit3 (eval (build-literal '(if > ?x ?y)))) +(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x})) + +(deftest test-join-literal + (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}])) + #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}})) + (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}]) + [{'?x 2}])) + (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}]) + [{'?x 3 '?y 1}]))) + +(deftest test-project-literal + (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}}) + (datalog-relation + ;; Schema + #{:y :x} + + ;; Data + #{ + {:x 1, :y 3} + {:x 4, :y 2} + } + + ;; Indexes + { + :x + { + 4 + #{{:x 4, :y 2}} + 1 + #{{:x 1, :y 3}} + } + })))) + + + +(comment + (run-tests) +) + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj new file mode 100644 index 00000000..7eabae78 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj @@ -0,0 +1,72 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-magic.clj +;; +;; A Clojure implementation of Datalog -- Magic Tests +;; +;; straszheimjeffrey (gmail) +;; Created 18 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-magic + (:use clojure.test) + (:use clojure.contrib.datalog.magic + clojure.contrib.datalog.rules)) + + + +(def rs (rules-set + (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y)) + (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y)) + (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y)) + (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y)))) + +(def q (adorn-query (?- :p :x 1 :y ?y))) + +(def ars (adorn-rules-set rs q)) + +(deftest test-adorn-rules-set + (is (= ars + (rules-set + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x)) + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x) + ({:pred :p :bound #{:x}} :y ?y :x ?z)) + (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x)) + (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x)))))) + + +(def m (magic-transform ars)) + +(deftest test-magic-transform + (is (= m + (rules-set + (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x)) + + (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x)) + + (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?z :x ?x)) + + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?z :x ?x) + ({:pred :p :bound #{:x}} :y ?y :x ?z)) + + (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)) + + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?y :x ?x)))))) + + + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj new file mode 100644 index 00000000..8b80b770 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj @@ -0,0 +1,130 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-rules.clj +;; +;; A Clojure implementation of Datalog -- Rule Tests +;; +;; straszheimjeffrey (gmail) +;; Created 12 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-rules + (:use clojure.test + clojure.contrib.datalog.rules + clojure.contrib.datalog.literals + clojure.contrib.datalog.database)) + + +(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y))) +(def tr-2 (<- (:fred) (not! :mary :x 3))) +(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y))) + + + +(deftest test-rule-safety + (is (thrown-with-msg? Exception #".*Head vars.*not bound.*" + (<- (:fred :x ?x) (:sally :y ?y)))) + (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" + (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y)))) + (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" + (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y))))) + + +(deftest test-sip + (is (= (compute-sip #{:x} #{:mary :sally} tr-1) + (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) + ({:pred :mary :bound #{:x}} :z ?z :x ?x) + ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) + + (is (= (compute-sip #{} #{:mary :sally} tr-1) + (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) + + (is (= (compute-sip #{} #{:mary} tr-2) + (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3)))) + + (is (= (compute-sip #{} #{} tr-2) + tr-2)) + + (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3)) + (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) + ({:pred :mary :bound #{:x}} :x ?x) + (:sally :y ?y) + (if > ?x ?y)))))) + ; Display rule is used because = does not work on + ; (if > ?x ?y) because it contains a closure + + +(def rs + (rules-set + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)) + (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y)))) + +(deftest test-rules-set + (is (= (count rs) 3)) + (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))))) + +(deftest test-predicate-map + (let [pm (predicate-map rs)] + (is (= (pm :path) + #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))})) + (is (= (-> :edge pm count) 1)))) + + +(def db1 (make-database + (relation :fred [:x :y]) + (index :fred :x) + (relation :sally [:x]) + (relation :ben [:y]))) + +(def db2 (add-tuples db1 + [:fred :x 1 :y :mary] + [:fred :x 1 :y :becky] + [:fred :x 3 :y :sally] + [:fred :x 4 :y :joe] + [:fred :x 4 :y :bob] + [:sally :x 1] + [:sally :x 2] + [:sally :x 3] + [:sally :x 4] + [:ben :y :bob])) + + +(deftest test-apply-rule + (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x) + (:fred :x ?x :y ?y) + (not! :ben :y ?y) + (if not= ?x 3))) + (datalog-database + { + :becky + (datalog-relation + ;; Schema + #{:y} + ;; Data + #{ + {:y :joe} + {:y :mary} + {:y :becky} + } + ;; Indexes + { + }) + })))) + + + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj new file mode 100644 index 00000000..a33d8c96 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj @@ -0,0 +1,233 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-softstrat.clj +;; +;; A Clojure implementation of Datalog -- Soft Stratification Tests +;; +;; straszheimjeffrey (gmail) +;; Created 28 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-softstrat + (:use clojure.test) + (:use clojure.contrib.datalog.softstrat + clojure.contrib.datalog.magic + clojure.contrib.datalog.rules + clojure.contrib.datalog.database) + (:use [clojure.contrib.set :only (subset?)])) + + + +(def rs1 (rules-set + (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z)) + (<- (:q :x ?x) (:d :x ?x)))) + +(def q1 (?- :p :x 1)) + +(def ws (build-soft-strat-work-plan rs1 q1)) + +(deftest test-soft-stratification + (let [soft (:stratification ws) + q (:query ws)] + (is (= q (?- {:pred :p :bound #{:x}} :x 1))) + (is (= (count soft) 4)) + (is (subset? (rules-set + (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x) + (:d :x ?x)) + + (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x))) + (nth soft 0))) + (is (= (nth soft 1) + (rules-set + (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x))))) + (is (= (nth soft 2) + (rules-set + (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x) + (not! {:pred :q :bound #{:x}} :x ?y))))) + (is (= (nth soft 3) + (rules-set + (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x) + (not! {:pred :q :bound #{:x}} :x ?y) + (not! {:pred :q :bound #{:x}} :x ?z))))))) + + +(def tdb-1 + (make-database + (relation :b [:x :y :z]) + (relation :d [:x]))) + +(def tdb-2 + (add-tuples tdb-1 + [:b :x 1 :y 2 :z 3])) + +(deftest test-tdb-2 + (is (= (evaluate-soft-work-set ws tdb-2 {}) + [{:x 1}]))) + + + +(def tdb-3 + (add-tuples tdb-2 + [:d :x 2] + [:d :x 3])) + +(deftest test-tdb-3 + (is (empty? (evaluate-soft-work-set ws tdb-3 {})))) + + + +;;;;;;;;;;; + + + +(def db-base + (make-database + (relation :employee [:id :name :position]) + (index :employee :name) + + (relation :boss [:employee-id :boss-id]) + (index :boss :employee-id) + + (relation :can-do-job [:position :job]) + (index :can-do-job :position) + + (relation :job-replacement [:job :can-be-done-by]) + + (relation :job-exceptions [:id :job]))) + +(def db + (add-tuples db-base + [:employee :id 1 :name "Bob" :position :boss] + [:employee :id 2 :name "Mary" :position :chief-accountant] + [:employee :id 3 :name "John" :position :accountant] + [:employee :id 4 :name "Sameer" :position :chief-programmer] + [:employee :id 5 :name "Lilian" :position :programmer] + [:employee :id 6 :name "Li" :position :technician] + [:employee :id 7 :name "Fred" :position :sales] + [:employee :id 8 :name "Brenda" :position :sales] + [:employee :id 9 :name "Miki" :position :project-management] + [:employee :id 10 :name "Albert" :position :technician] + + [:boss :employee-id 2 :boss-id 1] + [:boss :employee-id 3 :boss-id 2] + [:boss :employee-id 4 :boss-id 1] + [:boss :employee-id 5 :boss-id 4] + [:boss :employee-id 6 :boss-id 4] + [:boss :employee-id 7 :boss-id 1] + [:boss :employee-id 8 :boss-id 7] + [:boss :employee-id 9 :boss-id 1] + [:boss :employee-id 10 :boss-id 6] + + [:can-do-job :position :boss :job :management] + [:can-do-job :position :accountant :job :accounting] + [:can-do-job :position :chief-accountant :job :accounting] + [:can-do-job :position :programmer :job :programming] + [:can-do-job :position :chief-programmer :job :programming] + [:can-do-job :position :technician :job :server-support] + [:can-do-job :position :sales :job :sales] + [:can-do-job :position :project-management :job :project-management] + + [:job-replacement :job :pc-support :can-be-done-by :server-support] + [:job-replacement :job :pc-support :can-be-done-by :programming] + [:job-replacement :job :payroll :can-be-done-by :accounting] + + [:job-exceptions :id 4 :job :pc-support])) + +(def rules + (rules-set + (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) + (:employee :id ?e-id :name ?x) + (:employee :id ?b-id :name ?y)) + (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) + (:works-for :employee ?z :boss ?y)) + (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) + (:can-do-job :position ?pos :job ?y)) + (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) + (:employee-job* :employee ?x :job ?z)) + (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) + (:employee :name ?x :position ?z) + (if = ?z :boss)) + (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) + (:employee :id ?id :name ?x) + (not! :job-exceptions :id ?id :job ?y)) + (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) + (not! :employee-job :employee ?y :job :pc-support)))) + + +(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x))) +(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name}))) + +(deftest test-ws-1 + (is (= (evaluate-1 "Albert") + #{{:employee "Albert", :boss "Li"} + {:employee "Albert", :boss "Sameer"} + {:employee "Albert", :boss "Bob"}})) + (is (empty? (evaluate-1 "Bob"))) + (is (= (evaluate-1 "John") + #{{:employee "John", :boss "Bob"} + {:employee "John", :boss "Mary"}}))) + + +(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x))) +(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name}))) + +(deftest test-ws-2 + (is (= (evaluate-2 "Albert") + #{{:employee "Albert", :job :pc-support} + {:employee "Albert", :job :server-support}})) + (is (= (evaluate-2 "Sameer") + #{{:employee "Sameer", :job :programming}})) + (is (= (evaluate-2 "Bob") + #{{:employee "Bob", :job :accounting} + {:employee "Bob", :job :management} + {:employee "Bob", :job :payroll} + {:employee "Bob", :job :pc-support} + {:employee "Bob", :job :project-management} + {:employee "Bob", :job :programming} + {:employee "Bob", :job :server-support} + {:employee "Bob", :job :sales}}))) + +(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x))) +(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name}))) + +(deftest test-ws-3 + (is (= (evaluate-3 "Albert") + #{{:name "Albert", :boss "Sameer"}}))) + +(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x))) + +(deftest test-ws-4 + (is (= (set (evaluate-soft-work-set ws-4 db {})) + #{{:employee "Miki", :boss "Bob"} + {:employee "Albert", :boss "Li"} + {:employee "Lilian", :boss "Sameer"} + {:employee "Li", :boss "Bob"} + {:employee "Lilian", :boss "Bob"} + {:employee "Brenda", :boss "Fred"} + {:employee "Fred", :boss "Bob"} + {:employee "John", :boss "Bob"} + {:employee "John", :boss "Mary"} + {:employee "Albert", :boss "Sameer"} + {:employee "Sameer", :boss "Bob"} + {:employee "Albert", :boss "Bob"} + {:employee "Brenda", :boss "Bob"} + {:employee "Mary", :boss "Bob"} + {:employee "Li", :boss "Sameer"}}))) + +(comment + (run-tests) +) + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj new file mode 100644 index 00000000..9a5d0460 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj @@ -0,0 +1,69 @@ +;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and +;; distribution terms for this software are covered by the Eclipse Public +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can +;; be found in the file epl-v10.html at the root of this distribution. By +;; using this software in any fashion, you are agreeing to be bound by the +;; terms of this license. You must not remove this notice, or any other, +;; from this software. +;; +;; test-util.clj +;; +;; A Clojure implementation of Datalog -- Utilities Tests +;; +;; straszheimjeffrey (gmail) +;; Created 11 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-util + (:use clojure.test + clojure.contrib.datalog.util) + (:use [clojure.contrib.except :only (throwf)])) + +(deftest test-is-var? + (is (is-var? '?x)) + (is (is-var? '?)) + (is (not (is-var? '??x))) + (is (not (is-var? '??))) + (is (not (is-var? 'x))) + (is (not (is-var? "fred"))) + (is (not (is-var? :q)))) + +(deftest test-map-values + (let [map {:fred 1 :sally 2}] + (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4})) + (is (= (map-values identity {}) {})))) + +(deftest test-keys-to-vals + (let [map {:fred 1 :sally 2 :joey 3}] + (is (= (set (keys-to-vals map [:fred :sally])) #{1 2})) + (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2})) + (is (empty? (keys-to-vals map []))) + (is (empty? (keys-to-vals {} [:fred]))))) + +(deftest test-reverse-map + (let [map {:fred 1 :sally 2 :joey 3} + map-1 (assoc map :mary 3)] + (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey})) + (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey}) + (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary}))))) + +(def some-maps + [ + { :a 1 :b 2 } + { :c 3 :b 3 } + { :d 4 :a 1 } + { :g 4 :b 4 } + { :a 2 :b 1 } + { :e 1 :f 1 } + ]) + +(def reduced (preduce + some-maps)) +(def merged (apply merge-with + some-maps)) + +(deftest test-preduce + (is (= reduced merged))) + |