Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Datomic queries in core.logic
(ns queries
(:refer-clojure :exclude [==])
(:use [clojure.core.logic])
(:use [datomic.api :only [q]]))
(defn query [rule xs]
(let [prule (prep rule)]
(map #(binding-map* prule (prep %)) xs)))
;; ---
;; ?answer binds a scalar
(q '[:find ?answer :in ?answer]
42)
;; #<HashSet [[42]]>
(binding-map '(?answer) [42])
;; {?answer 42}
;; ---
;; of course you can bind more than one of anything
(q '[:find ?last ?first :in ?last ?first]
"Doe" "John")
;; #<HashSet [["Doe" "John"]]>
(query '(?last ?first) [["Doe" "John"]])
;; ({?first "John", ?last "Doe"})
;; ---
;; [?first ...] binds a collection
(q '[:find ?first
:in [?first ...]]
["John" "Jane" "Phineas"])
;; #<HashSet [["Jane"], ["Phineas"], ["John"]]>
(defn query-seq
"Wraps each member of a collection in vector before calling query"
[rule xs]
(query rule (map vector xs)))
(query-seq '(?first) ["ole" "dole" "doff"])
;; ({?first "ole"} {?first "dole"} {?first "doff"})
; ---
;; [[?first ?last]] binds a relation
(q '[:find ?first
:in [[?first ?last]]]
[["John" "Doe"]
["Jane" "Doe"]])
;; #<HashSet [["Jane"], ["John"]]>
(defn query-f
"Applies f to each result of a query"
[rule f xs]
(filter #(not (nil? %)) (map f (query rule xs))))
(query-f '(?first ?last) #(get % '?first)
[["John" "Doe"]
["Jane" "Doe"]])
;; ("John" "Jane")
;; ---
(q '[:find ?first
:where [_ :firstName ?first]]
[[1 :firstName "John" 42]
[1 :lastName "Doe" 42]])
;; #<HashSet [["John"]]>
(query-f '(?a :firstName ?first ?b) #(get % '?first)
[[1 :firstName "John" 42]
[1 :lastName "Doe" 42]])
;; ("John")
;; ---
;; simple in-memory join, two relation bindings
(q '[:find ?first ?height
:in [[?last ?first ?email]] [[?email ?height]]]
[["Doe" "John" "jdoe@example.com"]
["Doe" "Jane" "jane@example.com"]]
[["jane@example.com" 73]
["jdoe@example.com" 71]])
;; #<HashSet [["Jane" 73], ["John" 71]]>
(defn join-test [xs ys]
(let [rx (query '(?last ?first ?email) xs)
ry (query '(?email ?height) ys)
r (clojure.set/join rx ry)]
(map (juxt '?first '?height) r)))
(join-test
[["Doe" "John" "jdoe@example.com"]
["Doe" "Jane" "jane@example.com"]]
[["jane@example.com" 73]
["jdoe@example.com" 71]])
;; (["John" 71] ["Jane" 73])
;; ---
(q '[:find ?car ?speed
:in [[?car ?speed]]
:where [(> ?speed 100)]]
[["Stock" 225]
["Spud" 80]
["Rocket" 400]
["Stock" 225]
["Clunker" 40]])
;; #<HashSet [["Stock" 225], ["Rocket" 400]]>
(->> [["Stock" 225]
["Spud" 80]
["Rocket" 400]
["Stock" 225]
["Clunker" 40]]
(query '(?car ?speed))
set
(filter #(> (get % '?speed) 100))
(map (juxt '?car '?speed)))
;; (["Rocket" 400] ["Stock" 225])
;; ---
(->> (q '[:find ?k ?v
:in [[?k ?v] ...]]
{:D 67.3 :A 99.5 :B 67.4 :C 67.5})
(sort-by second))
(->>
{:D 67.3 :A 99.5 :B 67.4 :C 67.5}
(sort-by second))
;; ---
;; simple in-memory join, two database bindings
(q '[:find ?first ?height
:in $db1 $db2
:where [$db1 ?e1 :firstName ?first]
[$db1 ?e1 :email ?email]
[$db2 ?e2 :email ?email]
[$db2 ?e2 :height ?height]]
[[1 :firstName "John"]
[1 :email "jdoe@example.com"]
[2 :firstName "Jane"]
[2 :email "jane@example.com"]]
[[100 :email "jane@example.com"]
[100 :height 73]
[101 :email "jdoe@example.com"]
[101 :height 71]])
;; #<HashSet [["Jane" 73], ["John" 71]]>
(defmacro defquery [relname find rels]
(let [idx-syms (->> (iterate inc 0)
(map (partial + 97))
(map #(str (char %)))
(map symbol)
(map #(with-meta % {:index :t})))
relname (fn [r] (symbol (str relname "-" (->> r (map name) (interpose "-") (reduce str)))))
lvars (fn [r] (->> r (map name) (map symbol)))
defrels (for [r rels] `(defrel ~(relname r) ~@(take (count r) idx-syms)))
joins (for [r rels] `(~(relname r) ~@(lvars r)))]
`(do
~@defrels
(defn ~(relname [:run]) []
(run* [q#]
(fresh [~@(set (mapcat lvars rels))]
~@joins
(== q# [~@(lvars find)])))))))
(do
(defquery join2 [:firstName :height] [[:e1 :firstName] [:e1 :email] [:e2 :email] [:e2 :height]])
(fact join2-e1-firstName 1 "John")
(fact join2-e1-email 1 "jdoe@example.com")
(fact join2-e1-firstName 2 "Jane")
(fact join2-e1-email 2 "jane@example.com")
(fact join2-e2-email 100 "jane@example.com")
(fact join2-e2-height 100 73)
(fact join2-e2-email 101 "jdoe@example.com")
(fact join2-e2-height 101 71)
(join2-run))
;; (["John" 71] ["Jane" 73])
;; =======================================================================
;; Benchmarks
(defn join-test2 [xs ys]
;; setup the relations
(defquery join [:first :height] [[:last :first :email] [:email :height]])
;; load the facts
(time
(do
(doseq [x xs] (apply fact join-last-first-email x))
(doseq [y ys] (apply fact join-email-height y))))
;; run the query
(time
(join-run)))
(defn bench [n f]
(let [rand-str #(str (java.util.UUID/randomUUID))
emails (repeatedly n rand-str)
name-email (reduce (fn [res em]
(conj res (vector (rand-str) (rand-str) em)))
[] emails)
email-height (reduce (fn [res em]
(conj res (vector em (rand-int 100))))
[] emails)]
(time (count (f name-email email-height)))))
(bench 5000 (partial q '[:find ?first ?height
:in [[?last ?first ?email]] [[?email ?height]]]))
;; "Elapsed time: 14757.248824 msecs"
;; 5000
(bench 5000 (partial q '[:find ?first ?height
:in $a $b
:where [$a ?last ?first ?email] [$b ?email ?height]]))
;; "Elapsed time: 10.869 msecs"
;; 5000
(bench 5000 join-test)
;; "Elapsed time: 185.604 msecs"
;; 5000
(bench 5000 join-test2)
;; "Elapsed time: 287.275 msecs" (loading the facts)
;; "Elapsed time: 127.188 msecs" (running the query)
;; "Elapsed time: 415.466 msecs" (total)
;; 5000
jonase commented Jul 16, 2012

Hi,

Where is get-matches (used on lines 83,84) defined?

Owner

Cut-and-paste-o :) fixed.

Very cool. I've been thinking it would be a neat project to add Datomic style query support to core.logic for working with in-memory data structures.

Owner

I think that's a very good feature. Being able to query in-memory data structures such as log rings easily (and with good performance) would be awesome, a core.logic killer feature :)

Unifications and joins will take you a long way...

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment