database.clj

;;  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