1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,233 @@
     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-softstrat.clj
    1.13 +;;
    1.14 +;;  A Clojure implementation of Datalog -- Soft Stratification Tests
    1.15 +;;
    1.16 +;;  straszheimjeffrey (gmail)
    1.17 +;;  Created 28 Feburary 2009
    1.18 +
    1.19 +(ns clojure.contrib.datalog.tests.test-softstrat
    1.20 +  (:use clojure.test)
    1.21 +  (:use clojure.contrib.datalog.softstrat
    1.22 +        clojure.contrib.datalog.magic
    1.23 +        clojure.contrib.datalog.rules
    1.24 +        clojure.contrib.datalog.database)
    1.25 +  (:use [clojure.contrib.set :only (subset?)]))
    1.26 +
    1.27 +
    1.28 +
    1.29 +(def rs1 (rules-set
    1.30 +            (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z))
    1.31 +            (<- (:q :x ?x) (:d :x ?x))))
    1.32 +
    1.33 +(def q1 (?- :p :x 1))
    1.34 +
    1.35 +(def ws (build-soft-strat-work-plan rs1 q1))
    1.36 +
    1.37 +(deftest test-soft-stratification
    1.38 +  (let [soft (:stratification ws)
    1.39 +        q (:query ws)]
    1.40 +    (is (= q (?- {:pred :p :bound #{:x}} :x 1)))
    1.41 +    (is (= (count soft) 4))
    1.42 +    (is (subset? (rules-set
    1.43 +                  (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x)
    1.44 +                                                      (:d :x ?x))
    1.45 +
    1.46 +                  (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
    1.47 +                                                                  (:b :z ?z :y ?y :x ?x)))
    1.48 +                 (nth soft 0)))
    1.49 +    (is (= (nth soft 1)
    1.50 +           (rules-set
    1.51 +            (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x)
    1.52 +                                                            (:b :z ?z :y ?y :x ?x)
    1.53 +                                                            (not! {:pred :q :bound #{:x}} :x ?x)))))
    1.54 +    (is (= (nth soft 2)
    1.55 +           (rules-set
    1.56 +            (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
    1.57 +                                                            (:b :z ?z :y ?y :x ?x)
    1.58 +                                                            (not! {:pred :q :bound #{:x}} :x ?x)
    1.59 +                                                            (not! {:pred :q :bound #{:x}} :x ?y)))))
    1.60 +    (is (= (nth soft 3)
    1.61 +           (rules-set
    1.62 +            (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
    1.63 +                                                (:b :z ?z :y ?y :x ?x)
    1.64 +                                                (not! {:pred :q :bound #{:x}} :x ?x)
    1.65 +                                                (not! {:pred :q :bound #{:x}} :x ?y)
    1.66 +                                                (not! {:pred :q :bound #{:x}} :x ?z)))))))
    1.67 +
    1.68 +
    1.69 +(def tdb-1
    1.70 +     (make-database
    1.71 +       (relation :b [:x :y :z])
    1.72 +       (relation :d [:x])))
    1.73 +
    1.74 +(def tdb-2
    1.75 +     (add-tuples tdb-1
    1.76 +                 [:b :x 1 :y 2 :z 3]))
    1.77 +
    1.78 +(deftest test-tdb-2
    1.79 +  (is (= (evaluate-soft-work-set ws tdb-2 {})
    1.80 +         [{:x 1}])))
    1.81 +
    1.82 +
    1.83 +
    1.84 +(def tdb-3
    1.85 +     (add-tuples tdb-2
    1.86 +                 [:d :x 2]
    1.87 +                 [:d :x 3]))
    1.88 +
    1.89 +(deftest test-tdb-3
    1.90 +  (is (empty? (evaluate-soft-work-set ws tdb-3 {}))))
    1.91 +         
    1.92 +
    1.93 +
    1.94 +;;;;;;;;;;;
    1.95 +
    1.96 +
    1.97 +
    1.98 +(def db-base
    1.99 +     (make-database
   1.100 +      (relation :employee [:id :name :position])
   1.101 +      (index :employee :name)
   1.102 +
   1.103 +      (relation :boss [:employee-id :boss-id])
   1.104 +      (index :boss :employee-id)
   1.105 +
   1.106 +      (relation :can-do-job [:position :job])
   1.107 +      (index :can-do-job :position)
   1.108 +
   1.109 +      (relation :job-replacement [:job :can-be-done-by])
   1.110 +
   1.111 +      (relation :job-exceptions [:id :job])))
   1.112 +
   1.113 +(def db
   1.114 +     (add-tuples db-base
   1.115 +           [:employee :id 1  :name "Bob"    :position :boss]
   1.116 +           [:employee :id 2  :name "Mary"   :position :chief-accountant]
   1.117 +           [:employee :id 3  :name "John"   :position :accountant]
   1.118 +           [:employee :id 4  :name "Sameer" :position :chief-programmer]
   1.119 +           [:employee :id 5  :name "Lilian" :position :programmer]
   1.120 +           [:employee :id 6  :name "Li"     :position :technician]
   1.121 +           [:employee :id 7  :name "Fred"   :position :sales]
   1.122 +           [:employee :id 8  :name "Brenda" :position :sales]
   1.123 +           [:employee :id 9  :name "Miki"   :position :project-management]
   1.124 +           [:employee :id 10 :name "Albert" :position :technician]
   1.125 +           
   1.126 +           [:boss :employee-id 2  :boss-id 1]
   1.127 +           [:boss :employee-id 3  :boss-id 2]
   1.128 +           [:boss :employee-id 4  :boss-id 1]
   1.129 +           [:boss :employee-id 5  :boss-id 4]
   1.130 +           [:boss :employee-id 6  :boss-id 4]
   1.131 +           [:boss :employee-id 7  :boss-id 1]
   1.132 +           [:boss :employee-id 8  :boss-id 7]
   1.133 +           [:boss :employee-id 9  :boss-id 1]
   1.134 +           [:boss :employee-id 10 :boss-id 6]
   1.135 +
   1.136 +           [:can-do-job :position :boss               :job :management]
   1.137 +           [:can-do-job :position :accountant         :job :accounting]
   1.138 +           [:can-do-job :position :chief-accountant   :job :accounting]
   1.139 +           [:can-do-job :position :programmer         :job :programming]
   1.140 +           [:can-do-job :position :chief-programmer   :job :programming]           
   1.141 +           [:can-do-job :position :technician         :job :server-support]
   1.142 +           [:can-do-job :position :sales              :job :sales]
   1.143 +           [:can-do-job :position :project-management :job :project-management]
   1.144 +
   1.145 +           [:job-replacement :job :pc-support :can-be-done-by :server-support]
   1.146 +           [:job-replacement :job :pc-support :can-be-done-by :programming]
   1.147 +           [:job-replacement :job :payroll    :can-be-done-by :accounting]
   1.148 +
   1.149 +           [:job-exceptions :id 4 :job :pc-support]))
   1.150 +
   1.151 +(def rules
   1.152 +     (rules-set
   1.153 +        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
   1.154 +                                               (:employee :id ?e-id :name ?x)
   1.155 +                                               (:employee :id ?b-id :name ?y))
   1.156 +        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
   1.157 +                                               (:works-for :employee ?z :boss ?y))
   1.158 +        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
   1.159 +                                                  (:can-do-job :position ?pos :job ?y))
   1.160 +        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
   1.161 +                                                  (:employee-job* :employee ?x  :job ?z))
   1.162 +        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
   1.163 +                                                  (:employee :name ?x :position ?z)
   1.164 +                                                  (if = ?z :boss))
   1.165 +        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
   1.166 +                                                 (:employee :id ?id :name ?x)
   1.167 +                                                 (not! :job-exceptions :id ?id :job ?y))
   1.168 +        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
   1.169 +                                    (not! :employee-job :employee ?y :job :pc-support))))
   1.170 +
   1.171 +
   1.172 +(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x)))
   1.173 +(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name})))
   1.174 +
   1.175 +(deftest test-ws-1
   1.176 +  (is (= (evaluate-1 "Albert")
   1.177 +         #{{:employee "Albert", :boss "Li"}
   1.178 +           {:employee "Albert", :boss "Sameer"}
   1.179 +           {:employee "Albert", :boss "Bob"}}))
   1.180 +  (is (empty? (evaluate-1 "Bob")))
   1.181 +  (is (= (evaluate-1 "John")
   1.182 +         #{{:employee "John", :boss "Bob"}
   1.183 +           {:employee "John", :boss "Mary"}})))
   1.184 +         
   1.185 +
   1.186 +(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x)))
   1.187 +(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name})))
   1.188 +
   1.189 +(deftest test-ws-2
   1.190 +  (is (= (evaluate-2 "Albert")
   1.191 +         #{{:employee "Albert", :job :pc-support}
   1.192 +           {:employee "Albert", :job :server-support}}))
   1.193 +  (is (= (evaluate-2 "Sameer")
   1.194 +         #{{:employee "Sameer", :job :programming}}))
   1.195 +  (is (= (evaluate-2 "Bob")
   1.196 +         #{{:employee "Bob", :job :accounting}
   1.197 +           {:employee "Bob", :job :management}
   1.198 +           {:employee "Bob", :job :payroll}
   1.199 +           {:employee "Bob", :job :pc-support}
   1.200 +           {:employee "Bob", :job :project-management}
   1.201 +           {:employee "Bob", :job :programming}
   1.202 +           {:employee "Bob", :job :server-support}
   1.203 +           {:employee "Bob", :job :sales}})))
   1.204 +
   1.205 +(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x)))
   1.206 +(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name})))
   1.207 +
   1.208 +(deftest test-ws-3
   1.209 +  (is (= (evaluate-3 "Albert")
   1.210 +         #{{:name "Albert", :boss "Sameer"}})))
   1.211 +
   1.212 +(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x)))
   1.213 +
   1.214 +(deftest test-ws-4
   1.215 +  (is (= (set (evaluate-soft-work-set ws-4 db {}))
   1.216 +         #{{:employee "Miki", :boss "Bob"}
   1.217 +           {:employee "Albert", :boss "Li"}
   1.218 +           {:employee "Lilian", :boss "Sameer"}
   1.219 +           {:employee "Li", :boss "Bob"}
   1.220 +           {:employee "Lilian", :boss "Bob"}
   1.221 +           {:employee "Brenda", :boss "Fred"}
   1.222 +           {:employee "Fred", :boss "Bob"}
   1.223 +           {:employee "John", :boss "Bob"}
   1.224 +           {:employee "John", :boss "Mary"}
   1.225 +           {:employee "Albert", :boss "Sameer"}
   1.226 +           {:employee "Sameer", :boss "Bob"}
   1.227 +           {:employee "Albert", :boss "Bob"}
   1.228 +           {:employee "Brenda", :boss "Bob"}
   1.229 +           {:employee "Mary", :boss "Bob"}
   1.230 +           {:employee "Li", :boss "Sameer"}})))
   1.231 +
   1.232 +(comment
   1.233 +  (run-tests)
   1.234 +)
   1.235 +
   1.236 +;; End of file