Skip to content
This repository has been archived by the owner on May 3, 2024. It is now read-only.

Commit

Permalink
Fixed lousy representation for adorned predicates
Browse files Browse the repository at this point in the history
  • Loading branch information
@straszheimjeffrey
straszheimjeffrey committed Mar 6, 2009
1 parent d6b2018 commit 14c51b3
Show file tree
Hide file tree
Showing 7 changed files with 89 additions and 53 deletions.
37 changes: 26 additions & 11 deletions src/clojure/contrib/datalog/literals.clj
View file
Expand Up @@ -261,7 +261,7 @@
bnds (intersection (literal-columns l) bound)]
(if (empty? bound)
l
(assoc l :predicate [pred bnds]))))
(assoc l :predicate {:pred pred :bound bnds}))))

(defmethod adorned-literal ::conditional
[l bound]
Expand All @@ -271,15 +271,13 @@
(defn get-adorned-bindings
"Get the bindings from this adorned literal."
[pred]
(if (vector? pred)
(last pred)
nil))
(:bound pred))

(defn get-base-predicate
"Get the base predicate from this predicate."
[pred]
(if (vector? pred)
(first pred)
(if (map? pred)
(:pred pred)
pred))


Expand All @@ -290,18 +288,17 @@
[l]
(assert (-> l :literal-type (isa? ::literal)))
(let [pred (literal-predicate l)
base-pred (get-base-predicate pred)
pred-map (if (map? pred) pred {:pred pred})
bound (get-adorned-bindings pred)
ntb (select-keys (:term-bindings l) bound)]
(assoc l :predicate [base-pred :magic bound] :term-bindings ntb :literal-type ::literal)))
(assoc l :predicate (assoc pred-map :magic true) :term-bindings ntb :literal-type ::literal)))

(defn literal-magic?
"Is this literal magic?"
[lit]
(let [pred (literal-predicate lit)]
(when (and (vector? pred)
(> (count pred) 1))
(= (pred 1) :magic))))
(when (map? pred)
(:magic pred))))

(defn build-seed-bindings
"Given a seed literal, already adorned and in magic form, convert
Expand All @@ -310,6 +307,24 @@
(assert (-> s :literal-type (isa? ::literal)))
(let [ntbs (map-values (fn [_] (gensym '?_gen_)) (:term-bindings s))]
(assoc s :term-bindings ntbs)))


;;; Semi-naive support

(defn negated-literal
"Given a literal l, return a negated version"
[l]
(assert (-> l :literal-type (= ::literal)))
(conj l :literal-type ::negated))

;(defn delta-literal
; "Given a literal l, return a delta version"
; [l]
; (let [pred (:predicate l)]
; (if (vector? pred)
; (assoc l :predicate (



;;; Database operations

Expand Down
1 change: 1 addition & 0 deletions src/clojure/contrib/datalog/magic.clj
View file
Expand Up @@ -57,6 +57,7 @@
new-needed (reduce add-preds remaining new-adorned-rules)]
(recur new-nrs new-needed))))))


;;; Magic !

(defn seed-relation
Expand Down
13 changes: 7 additions & 6 deletions src/clojure/contrib/datalog/seminaive.clj
View file
Expand Up @@ -38,19 +38,20 @@
head-negated (negated-literal head)
delta-head (delta-literal head)
body (:body r)
build-body (fn [left lit right]
(assoc r :head delta-head
:body (concat left
[(delta-literal lit)]
right
[head-negated])))
new-rules (loop [lit (first body)
left []
right (next body)
results []]
(if (nil? lit)
results
(let [new-results (if (i-preds lit)
(conj results
(assoc r :head delta-head
:body (concat left
[(delta-literal lit)]
right
[head-negated])))
(conj results (build-body left lit right))
results)]
(recur (first right)
(conj left lit)
Expand Down
15 changes: 10 additions & 5 deletions src/clojure/contrib/datalog/tests/test_literals.clj
View file
Expand Up @@ -95,9 +95,9 @@

(deftest test-adorned-literal
(is (= (literal-predicate (adorned-literal pl #{:x}))
[:fred #{:x}]))
{:pred :fred :bound #{:x}}))
(is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
[:fred #{:x :y}]))
{:pred :fred :bound #{:x :y}}))
(is (= (:term-bindings (adorned-literal nl #{:x}))
{:x '?x :y '?y :z 3}))
(is (= (adorned-literal cl #{})
Expand All @@ -117,12 +117,17 @@

(deftest test-magic-literal
(is (= (magic-literal pl)
{:predicate [:fred :magic nil], :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
{:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
(is (= (magic-literal (adorned-literal pl #{:x}))
{:predicate [:fred :magic #{:x}],
{:predicate {:pred :fred :magic true :bound #{:x}},
:term-bindings {:x '?x},
:literal-type :clojure.contrib.datalog.literals/literal})))

(comment
(use 'clojure.contrib.stacktrace) (e)
(use :reload 'clojure.contrib.datalog.literals)
)


(def db1 (make-database
(relation :fred [:x :y])
Expand Down Expand Up @@ -151,7 +156,7 @@
[{'?x 3 '?y 1}])))

(deftest test-project-literal
(is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) [:joan #{:x}])
(is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}})
(datalog-relation
;; Schema
#{:y :x}
Expand Down
30 changes: 20 additions & 10 deletions src/clojure/contrib/datalog/tests/test_magic.clj
View file
Expand Up @@ -33,23 +33,33 @@
(deftest test-adorn-rules-set
(is (= ars
(rules-set
(<- ([:p #{:x}] :y ?y :x ?x) ([:e #{:x}] :y ?y :x ?x))
(<- ([:p #{:x}] :y ?y :x ?x) ([:e #{:x}] :y ?z :x ?x) ([:p #{:x}] :y ?y :x ?z))
(<- ([:e #{:x}] :y ?y :x ?y) (:c :y ?y :x ?x))
(<- ([:e #{:x}] :y ?y :x ?x) (:b :y ?y :x ?x))))))
(<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x))
(<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x)
({:pred :p :bound #{:x}} :y ?y :x ?z))
(<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x))
(<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x))))))


(def m (magic-transform ars))

(deftest test-magic-transform
(is (= m
(rules-set
(<- ([:e #{:x}] :y ?y :x ?y) ([:e :magic #{:x}] :x ?y) (:c :y ?y :x ?x))
(<- ([:e #{:x}] :y ?y :x ?x) ([:e :magic #{:x}] :x ?x) (:b :y ?y :x ?x))
(<- ([:p :magic #{:x}] :x ?z) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?z :x ?x))
(<- ([:p #{:x}] :y ?y :x ?x) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?z :x ?x) ([:p #{:x}] :y ?y :x ?z))
(<- ([:e :magic #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x))
(<- ([:p #{:x}] :y ?y :x ?x) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?y :x ?x))))))
(<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x))

(<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x))

(<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
({:pred :e :bound #{:x}} :y ?z :x ?x))

(<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
({:pred :e :bound #{:x}} :y ?z :x ?x)
({:pred :p :bound #{:x}} :y ?y :x ?z))

(<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x))

(<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
({:pred :e :bound #{:x}} :y ?y :x ?x))))))



Expand Down
12 changes: 7 additions & 5 deletions src/clojure/contrib/datalog/tests/test_rules.clj
View file
Expand Up @@ -38,20 +38,22 @@

(deftest test-sip
(is (= (compute-sip #{:x} #{:mary :sally} tr-1)
(<- ([:fred #{:x}] :x ?x :y ?y) ([:mary #{:x}] :z ?z :x ?x) ([:sally #{:z}] :y ?y :z ?z))))
(<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
({:pred :mary :bound #{:x}} :z ?z :x ?x)
({:pred :sally :bound #{:z}} :y ?y :z ?z))))

(is (= (compute-sip #{} #{:mary :sally} tr-1)
(<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ([:sally #{:z}] :y ?y :z ?z))))
(<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))

(is (= (compute-sip #{} #{:mary} tr-2)
(<- (:fred) (not! [:mary #{:x}] :x 3))))
(<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))

(is (= (compute-sip #{} #{} tr-2)
tr-2))

(is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))
(display-rule (<- ([:fred #{:x}] :x ?x :y ?y)
([:mary #{:x}] :x ?x)
(display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
({:pred :mary :bound #{:x}} :x ?x)
(:sally :y ?y)
(if > ?x ?y))))))
; Display rule is used because = does not work on
Expand Down
34 changes: 18 additions & 16 deletions src/clojure/contrib/datalog/tests/test_softstrat.clj
View file
Expand Up @@ -34,31 +34,33 @@
(deftest test-soft-stratification
(let [soft (:stratification ws)
q (:query ws)]
(is (= q (?- [:p #{:x}] :x 1)))
(is (= q (?- {:pred :p :bound #{:x}} :x 1)))
(is (= (count soft) 4))
(is (subset? (rules-set
(<- ([:q #{:x}] :x ?x) ([:q :magic #{:x}] :x ?x) (:d :x ?x))
(<- ([:q :magic #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x)
(:b :z ?z :y ?y :x ?x)))
(<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x)
(:d :x ?x))

(<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
(:b :z ?z :y ?y :x ?x)))
(nth soft 0)))
(is (= (nth soft 1)
(rules-set
(<- ([:q :magic #{:x}] :x ?y) ([:p :magic #{:x}] :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! [:q #{:x}] :x ?x)))))
(<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! {:pred :q :bound #{:x}} :x ?x)))))
(is (= (nth soft 2)
(rules-set
(<- ([:q :magic #{:x}] :x ?z) ([:p :magic #{:x}] :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! [:q #{:x}] :x ?x)
(not! [:q #{:x}] :x ?y)))))
(<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! {:pred :q :bound #{:x}} :x ?x)
(not! {:pred :q :bound #{:x}} :x ?y)))))
(is (= (nth soft 3)
(rules-set
(<- ([:p #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! [:q #{:x}] :x ?x)
(not! [:q #{:x}] :x ?y)
(not! [:q #{:x}] :x ?z)))))))
(<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
(:b :z ?z :y ?y :x ?x)
(not! {:pred :q :bound #{:x}} :x ?x)
(not! {:pred :q :bound #{:x}} :x ?y)
(not! {:pred :q :bound #{:x}} :x ?z)))))))


(def tdb-1
Expand Down

0 comments on commit 14c51b3

Please sign in to comment.