-
Notifications
You must be signed in to change notification settings - Fork 82
/
softstrat.clj
161 lines (137 loc) · 5.35 KB
/
softstrat.clj
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
;; 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