Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 288 lines (242 sloc) 8.52 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; database.clj
;;
;; A Clojure implementation of Datalog -- Support for in-memory database
;;
;; straszheimjeffrey (gmail)
;; Created 21 Feburary 2009


(ns clojure.contrib.datalog.database
  (:use clojure.contrib.datalog.util)
  (:use clojure.contrib.def)
  (:use [clojure.set :only (union intersection difference)])
  (:use [clojure.contrib.except :only (throwf)]))


(defstruct relation
  :schema ; A set of key names
  :data ; A set of tuples
  :indexes) ; A map key names to indexes (in turn a map of value to tuples)


;;; DDL

(defmethod print-method ::datalog-database
  [db #^Writer writer]
  (binding [*out* writer]
    (do
      (println "(datalog-database")
      (println "{")
      (doseq [key (keys db)]
        (println)
        (println key)
        (print-method (db key) writer))
      (println "})"))))

(defn datalog-database
  [rels]
  (with-meta rels {:type ::datalog-database}))

(def empty-database (datalog-database {}))

(defmethod print-method ::datalog-relation
  [rel #^Writer writer]
  (binding [*out* writer]
    (do
      (println "(datalog-relation")
      (println " ;; Schema")
      (println " " (:schema rel))
      (println)
      (println " ;; Data")
      (println " #{")
      (doseq [tuple (:data rel)]
        (println " " tuple))
      (println " }")
      (println)
      (println " ;; Indexes")
      (println " {")
      (doseq [key (-> rel :indexes keys)]
        (println " " key)
        (println " {")
        (doseq [val (keys ((:indexes rel) key))]
          (println " " val)
          (println " " (get-in rel [:indexes key val])))
        (println " }"))
      (println " })"))))

(defn datalog-relation
  "Creates a relation"
  [schema data indexes]
  (with-meta (struct relation schema data indexes) {:type ::datalog-relation}))

(defn add-relation
  "Adds a relation to the database"
  [db name keys]
  (assoc db name (datalog-relation (set keys) #{} {})))

(defn add-index
  "Adds an index to an empty relation named name"
  [db name key]
  (assert (empty? (:data (db name))))
  (let [rel (db name)
        inx (assoc (:indexes rel) key {})]
    (assoc db name (datalog-relation (:schema rel)
                                     (:data rel)
                                     inx))))

(defn ensure-relation
  "If the database lacks the named relation, add it"
  [db name keys indexes]
  (if-let [rel (db name)]
    (do
      (assert (= (:schema rel) (set keys)))
      db)
    (let [db1 (add-relation db name keys)]
      (reduce (fn [db key] (add-index db name key))
              db1
              indexes))))
    

(defmacro make-database
  "Makes a database, like this
(make-database
(relation :fred [:mary :sue])
(index :fred :mary)
(relation :sally [:jen :becky])
(index :sally :jen)
(index :sally :becky))"
  [& commands]
  (let [wrapper (fn [cur new]
                  (let [cmd (first new)
                        body (next new)]
                    (assert (= 2 (count body)))
                    (cond
                     (= cmd 'relation)
                       `(add-relation ~cur ~(first body) ~(fnext body))
                     (= cmd 'index)
                       `(add-index ~cur ~(first body) ~(fnext body))
                     :otherwise (throwf "%s not recognized" new))))]
    (reduce wrapper `empty-database commands)))

(defn get-relation
  "Get a relation object by name"
  [db rel-name]
  (db rel-name))

(defn replace-relation
  "Add or replace a fully constructed relation object to the database."
  [db rel-name rel]
  (assoc db rel-name rel))


;;; DML


(defn database-counts
  "Returns a map with the count of elements in each relation."
  [db]
  (map-values #(-> % :data count) db))

(defn- modify-indexes
  "Perform f on the indexed tuple-set. f should take a set and tuple,
and return the new set."
  [idxs tuple f]
  (into {} (for [ik (keys idxs)]
             (let [im (idxs ik)
                   iv (tuple ik)
                   os (get im iv #{})
                   ns (f os tuple)]
               [ik (if (empty? ns)
                     (dissoc im iv)
                     (assoc im iv (f os tuple)))]))))

(defn- add-to-indexes
  "Adds the tuple to the appropriate keys in the index map"
  [idxs tuple]
  (modify-indexes idxs tuple conj))

(defn- remove-from-indexes
  "Removes the tuple from the appropriate keys in the index map"
  [idxs tuple]
  (modify-indexes idxs tuple disj))

(defn add-tuple
  "Two forms:

[db relation-name tuple] adds tuple to the named relation. Returns
the new database.

[rel tuple] adds to the relation object. Returns the new relation."
  ([db rel-name tuple]
     (assert (= (-> tuple keys set) (-> rel-name db :schema)))
     (assoc db rel-name (add-tuple (db rel-name) tuple)))
  ([rel tuple]
     (let [data (:data rel)
           new-data (conj data tuple)]
       (if (identical? data new-data) ; optimization hack!
         rel
         (let [idxs (add-to-indexes (:indexes rel) tuple)]
           (assoc rel :data new-data :indexes idxs))))))

(defn remove-tuple
  "Two forms:

[db relation-name tuple] removes the tuple from the named relation,
returns a new database.

[rel tuple] removes the tuple from the relation. Returns the new
relation."
  ([db rel-name tuple] (assoc db rel-name (remove-tuple (db rel-name) tuple)))
  ([rel tuple]
     (let [data (:data rel)
           new-data (disj data tuple)]
       (if (identical? data new-data)
         rel
         (let [idxs (remove-from-indexes (:indexes rel) tuple)]
           (assoc rel :data new-data :indexes idxs))))))
                      
(defn add-tuples
  "Adds a collection of tuples to the db, as
(add-tuples db
[:rel-name :key-1 1 :key-2 2]
[:rel-name :key-1 2 :key-2 3])"
  [db & tupls]
  (reduce #(add-tuple %1 (first %2) (apply hash-map (next %2))) db tupls))

(defn- find-indexes
  "Given a map of indexes and a partial tuple, return the sets of full tuples"
  [idxs pt]
  (if (empty? idxs)
    nil
    (filter identity (for [key (keys pt)]
                       (if-let [idx-map (idxs key)]
                         (get idx-map (pt key) #{})
                         nil)))))

(defn- match?
  "Is m2 contained in m1?"
  [m1 m2]
  (let [compare (fn [key]
                  (and (contains? m1 key)
                       (= (m1 key) (m2 key))))]
  (every? compare (keys m2))))

(defn- scan-space
  "Computes a stream of tuples from relation rn matching partial tuple (pt)
and applies fun to each"
  [fun db rn pt]
  (let [rel (db rn)
        idxs (find-indexes (:indexes rel) pt)
        space (if (empty? idxs)
                (:data rel) ; table scan :(
                (reduce intersection idxs))]
    (trace-datalog (when (empty? idxs)
                     (println (format "Table scan of %s: %s rows!!!!!"
                                      rn
                                      (count space)))))
    (fun #(match? % pt) space)))
    
(defn select
  "finds all matching tuples to the partial tuple (pt) in the relation named (rn)"
  [db rn pt]
  (scan-space filter db rn pt))

(defn any-match?
  "Finds if there are any matching records for the partial tuple"
  [db rn pt]
  (if (= (-> pt keys set) (:schema (db rn)))
    (contains? (:data (db rn)) pt)
    (scan-space some db rn pt)))


;;; Merge

(defn merge-indexes
  [idx1 idx2]
  (merge-with (fn [h1 h2] (merge-with union h1 h2)) idx1 idx2))
  
(defn merge-relations
  "Merges two relations"
  [r1 r2]
  (assert (= (:schema r1) (:schema r2)))
  (let [merged-indexes (merge-indexes (:indexes r1)
                                      (:indexes r2))
        merged-data (union (:data r1)
                           (:data r2))]
    (assoc r1 :data merged-data :indexes merged-indexes)))
    
(defn database-merge
  "Merges databases together"
  [dbs]
  (apply merge-with merge-relations dbs))

(defn database-merge-parallel
  "Merges databases together in parallel"
  [dbs]
  (preduce merge-relations dbs))


;; End of file
Something went wrong with that request. Please try again.