Mercurial > lasercutter
comparison src/clojure/contrib/test_contrib/datalog/example.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
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 ;; example.clj | |
10 ;; | |
11 ;; A Clojure implementation of Datalog - Example | |
12 ;; | |
13 ;; straszheimjeffrey (gmail) | |
14 ;; Created 2 March 2009 | |
15 | |
16 | |
17 (ns clojure.contrib.datalog.example | |
18 (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)] | |
19 [clojure.contrib.datalog.rules :only (<- ?- rules-set)] | |
20 [clojure.contrib.datalog.database :only (make-database add-tuples)] | |
21 [clojure.contrib.datalog.util :only (*trace-datalog*)])) | |
22 | |
23 | |
24 | |
25 | |
26 (def db-base | |
27 (make-database | |
28 (relation :employee [:id :name :position]) | |
29 (index :employee :name) | |
30 | |
31 (relation :boss [:employee-id :boss-id]) | |
32 (index :boss :employee-id) | |
33 | |
34 (relation :can-do-job [:position :job]) | |
35 (index :can-do-job :position) | |
36 | |
37 (relation :job-replacement [:job :can-be-done-by]) | |
38 ;(index :job-replacement :can-be-done-by) | |
39 | |
40 (relation :job-exceptions [:id :job]))) | |
41 | |
42 (def db | |
43 (add-tuples db-base | |
44 [:employee :id 1 :name "Bob" :position :boss] | |
45 [:employee :id 2 :name "Mary" :position :chief-accountant] | |
46 [:employee :id 3 :name "John" :position :accountant] | |
47 [:employee :id 4 :name "Sameer" :position :chief-programmer] | |
48 [:employee :id 5 :name "Lilian" :position :programmer] | |
49 [:employee :id 6 :name "Li" :position :technician] | |
50 [:employee :id 7 :name "Fred" :position :sales] | |
51 [:employee :id 8 :name "Brenda" :position :sales] | |
52 [:employee :id 9 :name "Miki" :position :project-management] | |
53 [:employee :id 10 :name "Albert" :position :technician] | |
54 | |
55 [:boss :employee-id 2 :boss-id 1] | |
56 [:boss :employee-id 3 :boss-id 2] | |
57 [:boss :employee-id 4 :boss-id 1] | |
58 [:boss :employee-id 5 :boss-id 4] | |
59 [:boss :employee-id 6 :boss-id 4] | |
60 [:boss :employee-id 7 :boss-id 1] | |
61 [:boss :employee-id 8 :boss-id 7] | |
62 [:boss :employee-id 9 :boss-id 1] | |
63 [:boss :employee-id 10 :boss-id 6] | |
64 | |
65 [:can-do-job :position :boss :job :management] | |
66 [:can-do-job :position :accountant :job :accounting] | |
67 [:can-do-job :position :chief-accountant :job :accounting] | |
68 [:can-do-job :position :programmer :job :programming] | |
69 [:can-do-job :position :chief-programmer :job :programming] | |
70 [:can-do-job :position :technician :job :server-support] | |
71 [:can-do-job :position :sales :job :sales] | |
72 [:can-do-job :position :project-management :job :project-management] | |
73 | |
74 [:job-replacement :job :pc-support :can-be-done-by :server-support] | |
75 [:job-replacement :job :pc-support :can-be-done-by :programming] | |
76 [:job-replacement :job :payroll :can-be-done-by :accounting] | |
77 | |
78 [:job-exceptions :id 4 :job :pc-support])) | |
79 | |
80 (def rules | |
81 (rules-set | |
82 (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) | |
83 (:employee :id ?e-id :name ?x) | |
84 (:employee :id ?b-id :name ?y)) | |
85 (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) | |
86 (:works-for :employee ?z :boss ?y)) | |
87 (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) | |
88 (:can-do-job :position ?pos :job ?y)) | |
89 (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) | |
90 (:employee-job* :employee ?x :job ?z)) | |
91 (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) | |
92 (:employee :name ?x :position ?z) | |
93 (if = ?z :boss)) | |
94 (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) | |
95 (:employee :id ?id :name ?x) | |
96 (not! :job-exceptions :id ?id :job ?y)) | |
97 (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) | |
98 (not! :employee-job :employee ?y :job :pc-support)))) | |
99 | |
100 | |
101 | |
102 (def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x))) | |
103 (run-work-plan wp-1 db {'??name "Albert"}) | |
104 | |
105 (def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x))) | |
106 (binding [*trace-datalog* true] | |
107 (run-work-plan wp-2 db {'??name "Li"})) | |
108 | |
109 (def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x))) | |
110 (run-work-plan wp-3 db {'??name "Albert"}) | |
111 | |
112 (def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y))) | |
113 (run-work-plan wp-4 db {}) | |
114 | |
115 | |
116 ;; End of file |