Datomic queries in core.logic

queries.clj

(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" "[email protected]"]
    ["Doe" "Jane" "[email protected]"]]
   [["[email protected]" 73]
    ["[email protected]" 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" "[email protected]"]
  ["Doe" "Jane" "[email protected]"]]
 [["[email protected]" 73]
  ["[email protected]" 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  "[email protected]"]
    [2 :firstName "Jane"]
    [2 :email "[email protected]"]]
   [[100 :email "[email protected]"]
    [100 :height 73]
    [101 :email "[email protected]"]
    [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 "[email protected]")
  (fact join2-e1-firstName 2 "Jane")
  (fact join2-e1-email 2 "[email protected]")
  (fact join2-e2-email 100 "[email protected]")
  (fact join2-e2-height 100 73)
  (fact join2-e2-email 101 "[email protected]")
  (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

Hi,

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

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.

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...