Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

162 lines (137 sloc) 5.481 kb
;; 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.
;;
;; softstrat.clj
;;
;; A Clojure implementation of Datalog -- Soft Stratification
;;
;; straszheimjeffrey (gmail)
;; Created 28 Feburary 2009
(ns clojure.contrib.datalog.softstrat
(:use clojure.contrib.datalog.util
clojure.contrib.datalog.database
clojure.contrib.datalog.literals
clojure.contrib.datalog.rules
clojure.contrib.datalog.magic)
(:use [clojure.set :only (union intersection difference)])
(:use [clojure.contrib.seq-utils :only (indexed)])
(:require [clojure.contrib.graph :as graph]))
;;; Dependency graph
(defn- build-rules-graph
"Given a rules-set (rs), build a graph where each predicate symbol in rs,
there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges
from the (literal-predicate h) -> (literal-predicate b-*), one for each
b-*."
[rs]
(let [preds (all-predicates rs)
pred-map (predicate-map rs)
step (fn [nbs pred]
(let [rules (pred-map pred)
preds (reduce (fn [pds lits]
(reduce (fn [pds lit]
(if-let [pred (literal-predicate lit)]
(conj pds pred)
pds))
pds
lits))
#{}
(map :body rules))]
(assoc nbs pred preds)))
neighbors (reduce step {} preds)]
(struct graph/directed-graph preds neighbors)))
(defn- build-def
"Given a rules-set, build its def function"
[rs]
(let [pred-map (predicate-map rs)
graph (-> rs
build-rules-graph
graph/transitive-closure
graph/add-loops)]
(fn [pred]
(apply union (map set (map pred-map (graph/get-neighbors graph pred)))))))
;;; Soft Stratificattion REQ Graph
(defn- req
"Returns a rules-set that is a superset of req(lit) for the lit at
index lit-index"
[rs soft-def rule lit-index]
(let [head (:head rule)
body (:body rule)
lit (nth body lit-index)
pre (subvec (vec body) 0 lit-index)]
(conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs)))
(build-rule (magic-literal lit) pre))))
(defn- rule-dep
"Given a rule, return the set of rules it depends on."
[rs mrs soft-def rule]
(let [step (fn [nrs [idx lit]]
(if (negated? lit)
(union nrs (req rs soft-def rule idx))
nrs))]
(intersection mrs
(reduce step empty-rules-set (-> rule :body indexed)))))
(defn- soft-strat-graph
"The dependency graph for soft stratification."
[rs mrs]
(let [soft-def (build-def rs)
step (fn [nbrs rule]
(assoc nbrs rule (rule-dep rs mrs soft-def rule)))
nbrs (reduce step {} mrs)]
(struct graph/directed-graph mrs nbrs)))
(defn- build-soft-strat
"Given a rules-set (unadorned) and an adorned query, return the soft
stratified list. The rules will be magic transformed, and the
magic seed will be appended."
[rs q]
(let [ars (adorn-rules-set rs q)
mrs (conj (magic-transform ars)
(seed-rule q))
gr (soft-strat-graph ars mrs)]
(map make-rules-set (graph/dependency-list gr))))
;;; Work plan
(defstruct soft-strat-work-plan
:query
:stratification)
(defn build-soft-strat-work-plan
"Return a work plan for the given rules-set and query"
[rs q]
(let [aq (adorn-query q)]
(struct soft-strat-work-plan aq (build-soft-strat rs aq))))
(defn get-all-relations
"Return a set of all relation names defined in this workplan"
[ws]
(apply union (map all-predicates (:stratification ws))))
;;; Evaluate
(defn- weak-consq-operator
[db strat]
(trace-datalog (println)
(println)
(println "=============== Begin iteration ==============="))
(let [counts (database-counts db)]
(loop [strat strat]
(let [rs (first strat)]
(if rs
(let [new-db (apply-rules-set db rs)]
(if (= counts (database-counts new-db))
(recur (next strat))
new-db))
db)))))
(defn evaluate-soft-work-set
([ws db] (evaluate-soft-work-set ws db {}))
([ws db bindings]
(let [query (:query ws)
strat (:stratification ws)
seed (seed-predicate-for-insertion query)
seeded-db (project-literal db seed [bindings] is-query-var?)
fun (fn [data]
(weak-consq-operator data strat))
equal (fn [db1 db2]
(= (database-counts db1) (database-counts db2)))
new-db (graph/fixed-point seeded-db fun nil equal)
pt (build-partial-tuple query bindings)]
(select new-db (literal-predicate query) pt))))
;; End of file
Jump to Line
Something went wrong with that request. Please try again.