lasercutter: src/clojure/contrib/datalog/database.clj comparison

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

-:35cf337adfcf
+:ef7dbbd6452c
+;;  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)])
+(:import java.io.Writer))
+(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

Mercurial > lasercutter

comparison src/clojure/contrib/datalog/database.clj @ 10:ef7dbbd6452c