1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/datalog/example.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,116 @@
     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 +;;  example.clj
    1.13 +;;
    1.14 +;;  A Clojure implementation of Datalog - Example
    1.15 +;;
    1.16 +;;  straszheimjeffrey (gmail)
    1.17 +;;  Created 2 March 2009
    1.18 +
    1.19 +
    1.20 +(ns clojure.contrib.datalog.example
    1.21 +  (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)]
    1.22 +        [clojure.contrib.datalog.rules :only (<- ?- rules-set)]
    1.23 +        [clojure.contrib.datalog.database :only (make-database add-tuples)]
    1.24 +        [clojure.contrib.datalog.util :only (*trace-datalog*)]))
    1.25 +
    1.26 +
    1.27 +
    1.28 +
    1.29 +(def db-base
    1.30 +     (make-database
    1.31 +      (relation :employee [:id :name :position])
    1.32 +      (index :employee :name)
    1.33 +
    1.34 +      (relation :boss [:employee-id :boss-id])
    1.35 +      (index :boss :employee-id)
    1.36 +
    1.37 +      (relation :can-do-job [:position :job])
    1.38 +      (index :can-do-job :position)
    1.39 +
    1.40 +      (relation :job-replacement [:job :can-be-done-by])
    1.41 +      ;(index :job-replacement :can-be-done-by)
    1.42 +
    1.43 +      (relation :job-exceptions [:id :job])))
    1.44 +
    1.45 +(def db
    1.46 +     (add-tuples db-base
    1.47 +           [:employee :id 1  :name "Bob"    :position :boss]
    1.48 +           [:employee :id 2  :name "Mary"   :position :chief-accountant]
    1.49 +           [:employee :id 3  :name "John"   :position :accountant]
    1.50 +           [:employee :id 4  :name "Sameer" :position :chief-programmer]
    1.51 +           [:employee :id 5  :name "Lilian" :position :programmer]
    1.52 +           [:employee :id 6  :name "Li"     :position :technician]
    1.53 +           [:employee :id 7  :name "Fred"   :position :sales]
    1.54 +           [:employee :id 8  :name "Brenda" :position :sales]
    1.55 +           [:employee :id 9  :name "Miki"   :position :project-management]
    1.56 +           [:employee :id 10 :name "Albert" :position :technician]
    1.57 +           
    1.58 +           [:boss :employee-id 2  :boss-id 1]
    1.59 +           [:boss :employee-id 3  :boss-id 2]
    1.60 +           [:boss :employee-id 4  :boss-id 1]
    1.61 +           [:boss :employee-id 5  :boss-id 4]
    1.62 +           [:boss :employee-id 6  :boss-id 4]
    1.63 +           [:boss :employee-id 7  :boss-id 1]
    1.64 +           [:boss :employee-id 8  :boss-id 7]
    1.65 +           [:boss :employee-id 9  :boss-id 1]
    1.66 +           [:boss :employee-id 10 :boss-id 6]
    1.67 +
    1.68 +           [:can-do-job :position :boss               :job :management]
    1.69 +           [:can-do-job :position :accountant         :job :accounting]
    1.70 +           [:can-do-job :position :chief-accountant   :job :accounting]
    1.71 +           [:can-do-job :position :programmer         :job :programming]
    1.72 +           [:can-do-job :position :chief-programmer   :job :programming]           
    1.73 +           [:can-do-job :position :technician         :job :server-support]
    1.74 +           [:can-do-job :position :sales              :job :sales]
    1.75 +           [:can-do-job :position :project-management :job :project-management]
    1.76 +
    1.77 +           [:job-replacement :job :pc-support :can-be-done-by :server-support]
    1.78 +           [:job-replacement :job :pc-support :can-be-done-by :programming]
    1.79 +           [:job-replacement :job :payroll    :can-be-done-by :accounting]
    1.80 +
    1.81 +           [:job-exceptions :id 4 :job :pc-support]))
    1.82 +
    1.83 +(def rules
    1.84 +     (rules-set
    1.85 +        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
    1.86 +                                               (:employee :id ?e-id :name ?x)
    1.87 +                                               (:employee :id ?b-id :name ?y))
    1.88 +        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
    1.89 +                                               (:works-for :employee ?z :boss ?y))
    1.90 +        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
    1.91 +                                                  (:can-do-job :position ?pos :job ?y))
    1.92 +        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
    1.93 +                                                  (:employee-job* :employee ?x  :job ?z))
    1.94 +        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
    1.95 +                                                  (:employee :name ?x :position ?z)
    1.96 +                                                  (if = ?z :boss))
    1.97 +        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
    1.98 +                                                 (:employee :id ?id :name ?x)
    1.99 +                                                 (not! :job-exceptions :id ?id :job ?y))
   1.100 +        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
   1.101 +                                    (not! :employee-job :employee ?y :job :pc-support))))
   1.102 +
   1.103 +
   1.104 +
   1.105 +(def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x)))
   1.106 +(run-work-plan wp-1 db {'??name "Albert"})
   1.107 +
   1.108 +(def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x)))
   1.109 +(binding [*trace-datalog* true]
   1.110 +  (run-work-plan wp-2 db {'??name "Li"}))
   1.111 +
   1.112 +(def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x)))
   1.113 +(run-work-plan wp-3 db {'??name "Albert"})
   1.114 +
   1.115 +(def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y)))
   1.116 +(run-work-plan wp-4 db {})
   1.117 +
   1.118 +
   1.119 +;; End of file