|
rlm@10
|
1 ;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and
|
|
rlm@10
|
2 ;; distribution terms for this software are covered by the Eclipse Public
|
|
rlm@10
|
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
|
|
rlm@10
|
4 ;; be found in the file epl-v10.html at the root of this distribution. By
|
|
rlm@10
|
5 ;; using this software in any fashion, you are agreeing to be bound by the
|
|
rlm@10
|
6 ;; terms of this license. You must not remove this notice, or any other,
|
|
rlm@10
|
7 ;; from this software.
|
|
rlm@10
|
8 ;;
|
|
rlm@10
|
9 ;; example.clj
|
|
rlm@10
|
10 ;;
|
|
rlm@10
|
11 ;; A Clojure implementation of Datalog - Example
|
|
rlm@10
|
12 ;;
|
|
rlm@10
|
13 ;; straszheimjeffrey (gmail)
|
|
rlm@10
|
14 ;; Created 2 March 2009
|
|
rlm@10
|
15
|
|
rlm@10
|
16
|
|
rlm@10
|
17 (ns clojure.contrib.datalog.example
|
|
rlm@10
|
18 (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)]
|
|
rlm@10
|
19 [clojure.contrib.datalog.rules :only (<- ?- rules-set)]
|
|
rlm@10
|
20 [clojure.contrib.datalog.database :only (make-database add-tuples)]
|
|
rlm@10
|
21 [clojure.contrib.datalog.util :only (*trace-datalog*)]))
|
|
rlm@10
|
22
|
|
rlm@10
|
23
|
|
rlm@10
|
24
|
|
rlm@10
|
25
|
|
rlm@10
|
26 (def db-base
|
|
rlm@10
|
27 (make-database
|
|
rlm@10
|
28 (relation :employee [:id :name :position])
|
|
rlm@10
|
29 (index :employee :name)
|
|
rlm@10
|
30
|
|
rlm@10
|
31 (relation :boss [:employee-id :boss-id])
|
|
rlm@10
|
32 (index :boss :employee-id)
|
|
rlm@10
|
33
|
|
rlm@10
|
34 (relation :can-do-job [:position :job])
|
|
rlm@10
|
35 (index :can-do-job :position)
|
|
rlm@10
|
36
|
|
rlm@10
|
37 (relation :job-replacement [:job :can-be-done-by])
|
|
rlm@10
|
38 ;(index :job-replacement :can-be-done-by)
|
|
rlm@10
|
39
|
|
rlm@10
|
40 (relation :job-exceptions [:id :job])))
|
|
rlm@10
|
41
|
|
rlm@10
|
42 (def db
|
|
rlm@10
|
43 (add-tuples db-base
|
|
rlm@10
|
44 [:employee :id 1 :name "Bob" :position :boss]
|
|
rlm@10
|
45 [:employee :id 2 :name "Mary" :position :chief-accountant]
|
|
rlm@10
|
46 [:employee :id 3 :name "John" :position :accountant]
|
|
rlm@10
|
47 [:employee :id 4 :name "Sameer" :position :chief-programmer]
|
|
rlm@10
|
48 [:employee :id 5 :name "Lilian" :position :programmer]
|
|
rlm@10
|
49 [:employee :id 6 :name "Li" :position :technician]
|
|
rlm@10
|
50 [:employee :id 7 :name "Fred" :position :sales]
|
|
rlm@10
|
51 [:employee :id 8 :name "Brenda" :position :sales]
|
|
rlm@10
|
52 [:employee :id 9 :name "Miki" :position :project-management]
|
|
rlm@10
|
53 [:employee :id 10 :name "Albert" :position :technician]
|
|
rlm@10
|
54
|
|
rlm@10
|
55 [:boss :employee-id 2 :boss-id 1]
|
|
rlm@10
|
56 [:boss :employee-id 3 :boss-id 2]
|
|
rlm@10
|
57 [:boss :employee-id 4 :boss-id 1]
|
|
rlm@10
|
58 [:boss :employee-id 5 :boss-id 4]
|
|
rlm@10
|
59 [:boss :employee-id 6 :boss-id 4]
|
|
rlm@10
|
60 [:boss :employee-id 7 :boss-id 1]
|
|
rlm@10
|
61 [:boss :employee-id 8 :boss-id 7]
|
|
rlm@10
|
62 [:boss :employee-id 9 :boss-id 1]
|
|
rlm@10
|
63 [:boss :employee-id 10 :boss-id 6]
|
|
rlm@10
|
64
|
|
rlm@10
|
65 [:can-do-job :position :boss :job :management]
|
|
rlm@10
|
66 [:can-do-job :position :accountant :job :accounting]
|
|
rlm@10
|
67 [:can-do-job :position :chief-accountant :job :accounting]
|
|
rlm@10
|
68 [:can-do-job :position :programmer :job :programming]
|
|
rlm@10
|
69 [:can-do-job :position :chief-programmer :job :programming]
|
|
rlm@10
|
70 [:can-do-job :position :technician :job :server-support]
|
|
rlm@10
|
71 [:can-do-job :position :sales :job :sales]
|
|
rlm@10
|
72 [:can-do-job :position :project-management :job :project-management]
|
|
rlm@10
|
73
|
|
rlm@10
|
74 [:job-replacement :job :pc-support :can-be-done-by :server-support]
|
|
rlm@10
|
75 [:job-replacement :job :pc-support :can-be-done-by :programming]
|
|
rlm@10
|
76 [:job-replacement :job :payroll :can-be-done-by :accounting]
|
|
rlm@10
|
77
|
|
rlm@10
|
78 [:job-exceptions :id 4 :job :pc-support]))
|
|
rlm@10
|
79
|
|
rlm@10
|
80 (def rules
|
|
rlm@10
|
81 (rules-set
|
|
rlm@10
|
82 (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
|
|
rlm@10
|
83 (:employee :id ?e-id :name ?x)
|
|
rlm@10
|
84 (:employee :id ?b-id :name ?y))
|
|
rlm@10
|
85 (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
|
|
rlm@10
|
86 (:works-for :employee ?z :boss ?y))
|
|
rlm@10
|
87 (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
|
|
rlm@10
|
88 (:can-do-job :position ?pos :job ?y))
|
|
rlm@10
|
89 (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
|
|
rlm@10
|
90 (:employee-job* :employee ?x :job ?z))
|
|
rlm@10
|
91 (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
|
|
rlm@10
|
92 (:employee :name ?x :position ?z)
|
|
rlm@10
|
93 (if = ?z :boss))
|
|
rlm@10
|
94 (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
|
|
rlm@10
|
95 (:employee :id ?id :name ?x)
|
|
rlm@10
|
96 (not! :job-exceptions :id ?id :job ?y))
|
|
rlm@10
|
97 (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
|
|
rlm@10
|
98 (not! :employee-job :employee ?y :job :pc-support))))
|
|
rlm@10
|
99
|
|
rlm@10
|
100
|
|
rlm@10
|
101
|
|
rlm@10
|
102 (def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x)))
|
|
rlm@10
|
103 (run-work-plan wp-1 db {'??name "Albert"})
|
|
rlm@10
|
104
|
|
rlm@10
|
105 (def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x)))
|
|
rlm@10
|
106 (binding [*trace-datalog* true]
|
|
rlm@10
|
107 (run-work-plan wp-2 db {'??name "Li"}))
|
|
rlm@10
|
108
|
|
rlm@10
|
109 (def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x)))
|
|
rlm@10
|
110 (run-work-plan wp-3 db {'??name "Albert"})
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y)))
|
|
rlm@10
|
113 (run-work-plan wp-4 db {})
|
|
rlm@10
|
114
|
|
rlm@10
|
115
|
|
rlm@10
|
116 ;; End of file
|
