diff options
Diffstat (limited to 'src/clojure/contrib/datalog/tests/test_softstrat.clj')
| -rw-r--r-- | src/clojure/contrib/datalog/tests/test_softstrat.clj | 233 |
1 files changed, 0 insertions, 233 deletions
diff --git a/src/clojure/contrib/datalog/tests/test_softstrat.clj b/src/clojure/contrib/datalog/tests/test_softstrat.clj deleted file mode 100644 index a33d8c96..00000000 --- a/src/clojure/contrib/datalog/tests/test_softstrat.clj +++ /dev/null @@ -1,233 +0,0 @@ -;; 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 |