Mercurial > lasercutter

     1 ;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and

     2 ;;  distribution terms for this software are covered by the Eclipse Public

     3 ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can

     4 ;;  be found in the file epl-v10.html at the root of this distribution.  By

     5 ;;  using this software in any fashion, you are agreeing to be bound by the

     6 ;;  terms of this license.  You must not remove this notice, or any other,

     7 ;;  from this software.

     8 ;;

     9 ;;  test-softstrat.clj

    10 ;;

    11 ;;  A Clojure implementation of Datalog -- Soft Stratification Tests

    12 ;;

    13 ;;  straszheimjeffrey (gmail)

    14 ;;  Created 28 Feburary 2009

    15 

    16 (ns clojure.contrib.datalog.tests.test-softstrat

    17   (:use clojure.test)

    18   (:use clojure.contrib.datalog.softstrat

    19         clojure.contrib.datalog.magic

    20         clojure.contrib.datalog.rules

    21         clojure.contrib.datalog.database)

    22   (:use [clojure.contrib.set :only (subset?)]))

    23 

    24 

    25 

    26 (def rs1 (rules-set

    27             (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z))

    28             (<- (:q :x ?x) (:d :x ?x))))

    29 

    30 (def q1 (?- :p :x 1))

    31 

    32 (def ws (build-soft-strat-work-plan rs1 q1))

    33 

    34 (deftest test-soft-stratification

    35   (let [soft (:stratification ws)

    36         q (:query ws)]

    37     (is (= q (?- {:pred :p :bound #{:x}} :x 1)))

    38     (is (= (count soft) 4))

    39     (is (subset? (rules-set

    40                   (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x)

    41                                                       (:d :x ?x))

    42 

    43                   (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)

    44                                                                   (:b :z ?z :y ?y :x ?x)))

    45                  (nth soft 0)))

    46     (is (= (nth soft 1)

    47            (rules-set

    48             (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x)

    49                                                             (:b :z ?z :y ?y :x ?x)

    50                                                             (not! {:pred :q :bound #{:x}} :x ?x)))))

    51     (is (= (nth soft 2)

    52            (rules-set

    53             (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)

    54                                                             (:b :z ?z :y ?y :x ?x)

    55                                                             (not! {:pred :q :bound #{:x}} :x ?x)

    56                                                             (not! {:pred :q :bound #{:x}} :x ?y)))))

    57     (is (= (nth soft 3)

    58            (rules-set

    59             (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)

    60                                                 (:b :z ?z :y ?y :x ?x)

    61                                                 (not! {:pred :q :bound #{:x}} :x ?x)

    62                                                 (not! {:pred :q :bound #{:x}} :x ?y)

    63                                                 (not! {:pred :q :bound #{:x}} :x ?z)))))))

    64 

    65 

    66 (def tdb-1

    67      (make-database

    68        (relation :b [:x :y :z])

    69        (relation :d [:x])))

    70 

    71 (def tdb-2

    72      (add-tuples tdb-1

    73                  [:b :x 1 :y 2 :z 3]))

    74 

    75 (deftest test-tdb-2

    76   (is (= (evaluate-soft-work-set ws tdb-2 {})

    77          [{:x 1}])))

    78 

    79 

    80 

    81 (def tdb-3

    82      (add-tuples tdb-2

    83                  [:d :x 2]

    84                  [:d :x 3]))

    85 

    86 (deftest test-tdb-3

    87   (is (empty? (evaluate-soft-work-set ws tdb-3 {}))))

    88          

    89 

    90 

    91 ;;;;;;;;;;;

    92 

    93 

    94 

    95 (def db-base

    96      (make-database

    97       (relation :employee [:id :name :position])

    98       (index :employee :name)

    99 

   100       (relation :boss [:employee-id :boss-id])

   101       (index :boss :employee-id)

   102 

   103       (relation :can-do-job [:position :job])

   104       (index :can-do-job :position)

   105 

   106       (relation :job-replacement [:job :can-be-done-by])

   107 

   108       (relation :job-exceptions [:id :job])))

   109 

   110 (def db

   111      (add-tuples db-base

   112            [:employee :id 1  :name "Bob"    :position :boss]

   113            [:employee :id 2  :name "Mary"   :position :chief-accountant]

   114            [:employee :id 3  :name "John"   :position :accountant]

   115            [:employee :id 4  :name "Sameer" :position :chief-programmer]

   116            [:employee :id 5  :name "Lilian" :position :programmer]

   117            [:employee :id 6  :name "Li"     :position :technician]

   118            [:employee :id 7  :name "Fred"   :position :sales]

   119            [:employee :id 8  :name "Brenda" :position :sales]

   120            [:employee :id 9  :name "Miki"   :position :project-management]

   121            [:employee :id 10 :name "Albert" :position :technician]

   122            

   123            [:boss :employee-id 2  :boss-id 1]

   124            [:boss :employee-id 3  :boss-id 2]

   125            [:boss :employee-id 4  :boss-id 1]

   126            [:boss :employee-id 5  :boss-id 4]

   127            [:boss :employee-id 6  :boss-id 4]

   128            [:boss :employee-id 7  :boss-id 1]

   129            [:boss :employee-id 8  :boss-id 7]

   130            [:boss :employee-id 9  :boss-id 1]

   131            [:boss :employee-id 10 :boss-id 6]

   132 

   133            [:can-do-job :position :boss               :job :management]

   134            [:can-do-job :position :accountant         :job :accounting]

   135            [:can-do-job :position :chief-accountant   :job :accounting]

   136            [:can-do-job :position :programmer         :job :programming]

   137            [:can-do-job :position :chief-programmer   :job :programming]           

   138            [:can-do-job :position :technician         :job :server-support]

   139            [:can-do-job :position :sales              :job :sales]

   140            [:can-do-job :position :project-management :job :project-management]

   141 

   142            [:job-replacement :job :pc-support :can-be-done-by :server-support]

   143            [:job-replacement :job :pc-support :can-be-done-by :programming]

   144            [:job-replacement :job :payroll    :can-be-done-by :accounting]

   145 

   146            [:job-exceptions :id 4 :job :pc-support]))

   147 

   148 (def rules

   149      (rules-set

   150         (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)

   151                                                (:employee :id ?e-id :name ?x)

   152                                                (:employee :id ?b-id :name ?y))

   153         (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)

   154                                                (:works-for :employee ?z :boss ?y))

   155         (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)

   156                                                   (:can-do-job :position ?pos :job ?y))

   157         (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)

   158                                                   (:employee-job* :employee ?x  :job ?z))

   159         (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)

   160                                                   (:employee :name ?x :position ?z)

   161                                                   (if = ?z :boss))

   162         (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)

   163                                                  (:employee :id ?id :name ?x)

   164                                                  (not! :job-exceptions :id ?id :job ?y))

   165         (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)

   166                                     (not! :employee-job :employee ?y :job :pc-support))))

   167 

   168 

   169 (def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x)))

   170 (defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name})))

   171 

   172 (deftest test-ws-1

   173   (is (= (evaluate-1 "Albert")

   174          #{{:employee "Albert", :boss "Li"}

   175            {:employee "Albert", :boss "Sameer"}

   176            {:employee "Albert", :boss "Bob"}}))

   177   (is (empty? (evaluate-1 "Bob")))

   178   (is (= (evaluate-1 "John")

   179          #{{:employee "John", :boss "Bob"}

   180            {:employee "John", :boss "Mary"}})))

   181          

   182 

   183 (def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x)))

   184 (defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name})))

   185 

   186 (deftest test-ws-2

   187   (is (= (evaluate-2 "Albert")

   188          #{{:employee "Albert", :job :pc-support}

   189            {:employee "Albert", :job :server-support}}))

   190   (is (= (evaluate-2 "Sameer")

   191          #{{:employee "Sameer", :job :programming}}))

   192   (is (= (evaluate-2 "Bob")

   193          #{{:employee "Bob", :job :accounting}

   194            {:employee "Bob", :job :management}

   195            {:employee "Bob", :job :payroll}

   196            {:employee "Bob", :job :pc-support}

   197            {:employee "Bob", :job :project-management}

   198            {:employee "Bob", :job :programming}

   199            {:employee "Bob", :job :server-support}

   200            {:employee "Bob", :job :sales}})))

   201 

   202 (def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x)))

   203 (defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name})))

   204 

   205 (deftest test-ws-3

   206   (is (= (evaluate-3 "Albert")

   207          #{{:name "Albert", :boss "Sameer"}})))

   208 

   209 (def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x)))

   210 

   211 (deftest test-ws-4

   212   (is (= (set (evaluate-soft-work-set ws-4 db {}))

   213          #{{:employee "Miki", :boss "Bob"}

   214            {:employee "Albert", :boss "Li"}

   215            {:employee "Lilian", :boss "Sameer"}

   216            {:employee "Li", :boss "Bob"}

   217            {:employee "Lilian", :boss "Bob"}

   218            {:employee "Brenda", :boss "Fred"}

   219            {:employee "Fred", :boss "Bob"}

   220            {:employee "John", :boss "Bob"}

   221            {:employee "John", :boss "Mary"}

   222            {:employee "Albert", :boss "Sameer"}

   223            {:employee "Sameer", :boss "Bob"}

   224            {:employee "Albert", :boss "Bob"}

   225            {:employee "Brenda", :boss "Bob"}

   226            {:employee "Mary", :boss "Bob"}

   227            {:employee "Li", :boss "Sameer"}})))

   228 

   229 (comment

   230   (run-tests)

   231 )

   232 

   233 ;; End of file
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children