comparison src/clojure/contrib/datalog/database.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 ;; database.clj
10 ;;
11 ;; A Clojure implementation of Datalog -- Support for in-memory database
12 ;;
13 ;; straszheimjeffrey (gmail)
14 ;; Created 21 Feburary 2009
15
16
17 (ns clojure.contrib.datalog.database
18 (:use clojure.contrib.datalog.util)
19 (:use clojure.contrib.def)
20 (:use [clojure.set :only (union intersection difference)])
21 (:use [clojure.contrib.except :only (throwf)])
22 (:import java.io.Writer))
23
24
25 (defstruct relation
26 :schema ; A set of key names
27 :data ; A set of tuples
28 :indexes) ; A map key names to indexes (in turn a map of value to tuples)
29
30
31 ;;; DDL
32
33 (defmethod print-method ::datalog-database
34 [db ^Writer writer]
35 (binding [*out* writer]
36 (do
37 (println "(datalog-database")
38 (println "{")
39 (doseq [key (keys db)]
40 (println)
41 (println key)
42 (print-method (db key) writer))
43 (println "})"))))
44
45 (defn datalog-database
46 [rels]
47 (with-meta rels {:type ::datalog-database}))
48
49 (def empty-database (datalog-database {}))
50
51 (defmethod print-method ::datalog-relation
52 [rel ^Writer writer]
53 (binding [*out* writer]
54 (do
55 (println "(datalog-relation")
56 (println " ;; Schema")
57 (println " " (:schema rel))
58 (println)
59 (println " ;; Data")
60 (println " #{")
61 (doseq [tuple (:data rel)]
62 (println " " tuple))
63 (println " }")
64 (println)
65 (println " ;; Indexes")
66 (println " {")
67 (doseq [key (-> rel :indexes keys)]
68 (println " " key)
69 (println " {")
70 (doseq [val (keys ((:indexes rel) key))]
71 (println " " val)
72 (println " " (get-in rel [:indexes key val])))
73 (println " }"))
74 (println " })"))))
75
76 (defn datalog-relation
77 "Creates a relation"
78 [schema data indexes]
79 (with-meta (struct relation schema data indexes) {:type ::datalog-relation}))
80
81 (defn add-relation
82 "Adds a relation to the database"
83 [db name keys]
84 (assoc db name (datalog-relation (set keys) #{} {})))
85
86 (defn add-index
87 "Adds an index to an empty relation named name"
88 [db name key]
89 (assert (empty? (:data (db name))))
90 (let [rel (db name)
91 inx (assoc (:indexes rel) key {})]
92 (assoc db name (datalog-relation (:schema rel)
93 (:data rel)
94 inx))))
95
96 (defn ensure-relation
97 "If the database lacks the named relation, add it"
98 [db name keys indexes]
99 (if-let [rel (db name)]
100 (do
101 (assert (= (:schema rel) (set keys)))
102 db)
103 (let [db1 (add-relation db name keys)]
104 (reduce (fn [db key] (add-index db name key))
105 db1
106 indexes))))
107
108
109 (defmacro make-database
110 "Makes a database, like this
111 (make-database
112 (relation :fred [:mary :sue])
113 (index :fred :mary)
114 (relation :sally [:jen :becky])
115 (index :sally :jen)
116 (index :sally :becky))"
117 [& commands]
118 (let [wrapper (fn [cur new]
119 (let [cmd (first new)
120 body (next new)]
121 (assert (= 2 (count body)))
122 (cond
123 (= cmd 'relation)
124 `(add-relation ~cur ~(first body) ~(fnext body))
125 (= cmd 'index)
126 `(add-index ~cur ~(first body) ~(fnext body))
127 :otherwise (throwf "%s not recognized" new))))]
128 (reduce wrapper `empty-database commands)))
129
130 (defn get-relation
131 "Get a relation object by name"
132 [db rel-name]
133 (db rel-name))
134
135 (defn replace-relation
136 "Add or replace a fully constructed relation object to the database."
137 [db rel-name rel]
138 (assoc db rel-name rel))
139
140
141 ;;; DML
142
143
144 (defn database-counts
145 "Returns a map with the count of elements in each relation."
146 [db]
147 (map-values #(-> % :data count) db))
148
149 (defn- modify-indexes
150 "Perform f on the indexed tuple-set. f should take a set and tuple,
151 and return the new set."
152 [idxs tuple f]
153 (into {} (for [ik (keys idxs)]
154 (let [im (idxs ik)
155 iv (tuple ik)
156 os (get im iv #{})
157 ns (f os tuple)]
158 [ik (if (empty? ns)
159 (dissoc im iv)
160 (assoc im iv (f os tuple)))]))))
161
162 (defn- add-to-indexes
163 "Adds the tuple to the appropriate keys in the index map"
164 [idxs tuple]
165 (modify-indexes idxs tuple conj))
166
167 (defn- remove-from-indexes
168 "Removes the tuple from the appropriate keys in the index map"
169 [idxs tuple]
170 (modify-indexes idxs tuple disj))
171
172 (defn add-tuple
173 "Two forms:
174
175 [db relation-name tuple] adds tuple to the named relation. Returns
176 the new database.
177
178 [rel tuple] adds to the relation object. Returns the new relation."
179 ([db rel-name tuple]
180 (assert (= (-> tuple keys set) (-> rel-name db :schema)))
181 (assoc db rel-name (add-tuple (db rel-name) tuple)))
182 ([rel tuple]
183 (let [data (:data rel)
184 new-data (conj data tuple)]
185 (if (identical? data new-data) ; optimization hack!
186 rel
187 (let [idxs (add-to-indexes (:indexes rel) tuple)]
188 (assoc rel :data new-data :indexes idxs))))))
189
190 (defn remove-tuple
191 "Two forms:
192
193 [db relation-name tuple] removes the tuple from the named relation,
194 returns a new database.
195
196 [rel tuple] removes the tuple from the relation. Returns the new
197 relation."
198 ([db rel-name tuple] (assoc db rel-name (remove-tuple (db rel-name) tuple)))
199 ([rel tuple]
200 (let [data (:data rel)
201 new-data (disj data tuple)]
202 (if (identical? data new-data)
203 rel
204 (let [idxs (remove-from-indexes (:indexes rel) tuple)]
205 (assoc rel :data new-data :indexes idxs))))))
206
207 (defn add-tuples
208 "Adds a collection of tuples to the db, as
209 (add-tuples db
210 [:rel-name :key-1 1 :key-2 2]
211 [:rel-name :key-1 2 :key-2 3])"
212 [db & tupls]
213 (reduce #(add-tuple %1 (first %2) (apply hash-map (next %2))) db tupls))
214
215 (defn- find-indexes
216 "Given a map of indexes and a partial tuple, return the sets of full tuples"
217 [idxs pt]
218 (if (empty? idxs)
219 nil
220 (filter identity (for [key (keys pt)]
221 (if-let [idx-map (idxs key)]
222 (get idx-map (pt key) #{})
223 nil)))))
224
225 (defn- match?
226 "Is m2 contained in m1?"
227 [m1 m2]
228 (let [compare (fn [key]
229 (and (contains? m1 key)
230 (= (m1 key) (m2 key))))]
231 (every? compare (keys m2))))
232
233 (defn- scan-space
234 "Computes a stream of tuples from relation rn matching partial tuple (pt)
235 and applies fun to each"
236 [fun db rn pt]
237 (let [rel (db rn)
238 idxs (find-indexes (:indexes rel) pt)
239 space (if (empty? idxs)
240 (:data rel) ; table scan :(
241 (reduce intersection idxs))]
242 (trace-datalog (when (empty? idxs)
243 (println (format "Table scan of %s: %s rows!!!!!"
244 rn
245 (count space)))))
246 (fun #(match? % pt) space)))
247
248 (defn select
249 "finds all matching tuples to the partial tuple (pt) in the relation named (rn)"
250 [db rn pt]
251 (scan-space filter db rn pt))
252
253 (defn any-match?
254 "Finds if there are any matching records for the partial tuple"
255 [db rn pt]
256 (if (= (-> pt keys set) (:schema (db rn)))
257 (contains? (:data (db rn)) pt)
258 (scan-space some db rn pt)))
259
260
261 ;;; Merge
262
263 (defn merge-indexes
264 [idx1 idx2]
265 (merge-with (fn [h1 h2] (merge-with union h1 h2)) idx1 idx2))
266
267 (defn merge-relations
268 "Merges two relations"
269 [r1 r2]
270 (assert (= (:schema r1) (:schema r2)))
271 (let [merged-indexes (merge-indexes (:indexes r1)
272 (:indexes r2))
273 merged-data (union (:data r1)
274 (:data r2))]
275 (assoc r1 :data merged-data :indexes merged-indexes)))
276
277 (defn database-merge
278 "Merges databases together"
279 [dbs]
280 (apply merge-with merge-relations dbs))
281
282 (defn database-merge-parallel
283 "Merges databases together in parallel"
284 [dbs]
285 (preduce merge-relations dbs))
286
287
288 ;; End of file