Merge pull request threatgrid#56 from quoll/outer-products-55

Adds outer products and optimizes large query analysis

Author: quoll

src/naga/lang/basic.clj

@@ -60,7 +60,7 @@
 
 ;; This does not include all legal characters.
 ;; Consider some others in future, especially >
-(def ns-word (many1 (choice (letter) (char \_) (char \-) (char \:))))
+(def ns-word (many1 (choice (letter) (digit) (char \_) (char \-) (char \:))))
 
 (def word (many1 (letter)))
 
@@ -97,7 +97,7 @@
 ;; variables start with a capital. Internally they start with ?
 (defparser variable []
  (let->> [f (upper-case-letter)
- r (many (letter))]
+ r (many (choice (letter) (digit) (char \_) (char \-)))]
  (always (symbol (apply str "?" (Character/toLowerCase f) r)))))
 
 (defn build-keyword
@@ -106,7 +106,8 @@
  (let [[kns kname :as w] (str/split wrd #":")
  parts (count w)]
  ;; use cond without a default to return nil
- (cond (= 2 parts) (cond (empty? kns) (keyword kname)
+ (cond (Character/isDigit (first wrd)) nil
+ (= 2 parts) (cond (empty? kns) (keyword kname)
  (seq kname) (keyword kns kname))
  (= 1 parts) (if-not (str/ends-with? wrd ":")
  (keyword kns)))))

src/naga/storage/memory/core.clj

@@ -23,33 +23,49 @@
  s :- [s/Any]]
  (remove (partial = e) s))
 
+(s/defn find-start :- EPVPattern
+ "Returns the first pattern with the smallest count"
+ [pattern-counts :- {EPVPattern s/Num}
+ patterns :- [EPVPattern]]
+ (let [local-counts (select-keys pattern-counts patterns)
+ low-count (reduce min (map second local-counts))
+ pattern (ffirst (filter #(= low-count (second %)) local-counts))]
+ ;; must use first/filter/= instead of some/#{pattern} because
+ ;; patterns contains metadata and pattern does not
+ (first (filter (partial = pattern) patterns))))
 
 (s/defn paths :- [[EPVPattern]]
  "Returns a seq of all paths through the constraints. A path is defined
  by new patterns containing at least one variable common to the patterns
- that appeared before it. This prevents cross products in a join."
- ([patterns :- [EPVPattern]]
- (let [all-paths (paths #{} patterns)]
- (assert (every? (partial = (count patterns)) (map count all-paths))
- (str "No valid paths through: " (vec patterns)))
- all-paths))
- ([bound :- #{Symbol}
- patterns :- [EPVPattern]]
- (apply concat
- (keep ;; discard paths that can't proceed (they return nil)
- (fn [p]
- (let [b (get-vars p)]
- ;; only proceed when the pattern matches what has been bound
- (if (or (empty? bound) (seq (set/intersection b bound)))
- ;; pattern can be added to the path, get the other patterns
- (let [remaining (without p patterns)]
- ;; if there are more patterns to add to the path, recurse
- (if (seq remaining)
- (map (partial cons p)
- (seq
- (paths (into bound b) remaining)))
- [[p]])))))
- patterns))))
+ that appeared before it. Patterns must form a group."
+ ([patterns :- [EPVPattern]
+ pattern-counts :- {EPVPattern s/Num}]
+ (s/letfn [(remaining-paths :- [[EPVPattern]]
+ [bound :- #{Symbol}
+ rpatterns :- [EPVPattern]]
+ (if (seq rpatterns)
+ (apply concat
+ (keep ;; discard paths that can't proceed (they return nil)
+ (fn [p]
+ (let [b (get-vars p)]
+ ;; only proceed when the pattern matches what has been bound
+ (if (or (empty? bound) (seq (set/intersection b bound)))
+ ;; pattern can be added to the path, get the other patterns
+ (let [remaining (without p rpatterns)]
+ ;; if there are more patterns to add to the path, recurse
+ (if (seq remaining)
+ (map (partial cons p)
+ (seq
+ (remaining-paths (into bound b) remaining)))
+ [[p]])))))
+ rpatterns))
+ [[]]))]
+ (let [start (find-start pattern-counts patterns)
+ all-paths (map (partial cons start)
+ (remaining-paths (get-vars start) (without start patterns)))]
+ (assert (every? (partial = (count patterns)) (map count all-paths))
+ (str "No valid paths through: " (vec patterns)))
+ all-paths))))
 
 
 (def epv-pattern? vector?)
@@ -75,18 +91,44 @@
  (recur (into plan nxt-filters) bound patterns remaining-filters)
  (recur (conj plan np) (into bound (get-vars np)) rp filters)))))))
 
+(s/defn first-group :- [(s/one [Pattern] "group") (s/one [Pattern] "remainder")]
+ "Finds a group from a sequence of patterns. A group is defined by every pattern
+ sharing at least one var with at least one other pattern. Returns a pair.
+ The first returned element is the Patterns in the group, the second is what was left over."
+ [[fp & rp] :- [Pattern]]
+ (letfn [;; Define a reduction step.
+ ;; Accumulates a triple of: known vars; patterns that are part of the group;
+ ;; patterns that are not in the group. Each step looks at a pattern for
+ ;; inclusion or exclusion
+ (step [[vs included excluded] next-pattern]
+ (let [new-vars (get-vars next-pattern)]
+ (if (seq (set/intersection vs new-vars))
+ [(into vs new-vars) (conj included next-pattern) excluded]
+ [vs included (conj excluded next-pattern)])))
+ ;; apply the reduction steps, with a given set of known vars, and
+ ;; included patterns. Previously excluded patterns are being scanned
+ ;; again using the new known vars.
+ (groups [[v i e]] (reduce step [v i []] e))]
+ ;; scan for everything that matches the first pattern, and then iterate until
+ ;; everything that matches the resulting patterns has also been found.
+ ;; Drop the set of vars before returning.
+ (rest (u/fixpoint groups [(get-vars fp) [fp] rp]))))
+
 (s/defn min-join-path :- [EPVPattern]
  "Calculates a plan based on no outer joins (a cross product), and minimized joins.
  A plan is the order in which to evaluate constraints and join them to the accumulated
  evaluated data. If it is not possible to create a path without a cross product,
  then return a plan of the patterns in the provided order."
  [patterns :- [Pattern]
  count-map :- {EPVPattern s/Num}]
- (or
- (->> (paths patterns)
- (sort-by (partial mapv count-map))
- first)
- patterns)) ;; TODO: longest paths with minimized cross products
+ (loop [[grp rmdr] (first-group patterns) ordered []]
+ (let [all-ordered (->> (paths grp count-map)
+ (sort-by (partial mapv count-map))
+ first
+ (concat ordered))] ;; TODO: order groups, rather than concat as found
+ (if (empty? rmdr)
+ all-ordered
+ (recur (first-group rmdr) all-ordered)))))
 
 (s/defn user-plan :- [EPVPattern]
  "Returns the original path specified by the user"

src/naga/util.clj

@@ -27,3 +27,23 @@
  symbol
  find-ns
  (ns-resolve snm))))
+
+(s/defn divide :- [[s/Any] [s/Any]]
+ "Takes a predicate and a sequence and returns 2 sequences.
+ The first is where the predicate returns true, and the second
+ is where the predicate returns false. Note that a nil value
+ will not be returned in either sequence, regardless of the
+ value returned by the predicate."
+ [p
+ s :- [s/Any]]
+ (let [d (map (fn [x] (if (p x) [x nil] [nil x])) s)]
+ [(keep first d) (keep second d)]))
+
+(defn fixpoint
+ "Applies the function f to the value a. The function is then,
+ and applied to the result, over and over, until the result does not change.
+ Returns the final result.
+ Note: If the function has no fixpoint, then runs forever."
+ [f a]
+ (let [s (iterate f a)]
+ (some identity (map #(#{%1} %2) s (rest s)))))

test/naga/storage/test_memory.clj

@@ -111,3 +111,69 @@
  (is (= #{[:pa :t]
  [:pb :u]
  [:pz :l]} r1))))
+
+(deftest test-query-path
+ (let [simple-p '[[?a :a :b] [?b :c :d]]
+ simple-cm '{[?a :a :b] 1, [?b :c :d] 1}
+ [g] (first-group simple-p)
+ p (min-join-path simple-p simple-cm)
+ simple-p2 '[[?a :a :b] [?b :c :d] [?c :e ?b] [?a :c :d]]
+ simple-cm2 '{[?a :a :b] 1, [?b :c :d] 2, [?c :e ?b] 1, [?a :c :d] 1}
+ [g2] (first-group simple-p2)
+ p2 (min-join-path simple-p2 simple-cm2)
+ patterns '[[?a :a :b]
+ [?b :c ?d]
+ [?d :d ?e]
+ [?d :e ?f]
+ [?f :f ?a]
+ [?f :g ?g]
+ [?g :v1 ?v1]
+ [?g :v2 ?v2]
+ [?h :v1 ?v1]
+ [?h :v2 ?v2]
+ [?i :i ?h]
+ [?other :id "id"]]
+ count-map '{[?a :a :b] 1
+ [?b :c ?d] 2
+ [?d :d ?e] 3
+ [?d :e ?f] 3
+ [?f :f ?a] 3
+ [?f :g ?g] 5
+ [?g :v1 ?v1] 3
+ [?g :v2 ?v2] 4
+ [?h :v1 ?v1] 5
+ [?h :v2 ?v2] 6
+ [?i :i ?h] 7
+ [?other :id "id"] 1}
+ [group] (first-group patterns)
+ path (min-join-path patterns count-map)]
+
+ (is (= '[[?a :a :b]] g))
+ (is (= '[[?a :a :b] [?b :c :d]] p))
+
+ (is (= '[[?a :a :b] [?a :c :d]] g2))
+ (is (= '[[?a :a :b] [?a :c :d] [?c :e ?b] [?b :c :d]] p2))
+
+ (is (= '[[?a :a :b]
+ [?f :f ?a]
+ [?f :g ?g]
+ [?g :v1 ?v1]
+ [?g :v2 ?v2]
+ [?h :v1 ?v1]
+ [?h :v2 ?v2]
+ [?i :i ?h]
+ [?d :e ?f]
+ [?b :c ?d]
+ [?d :d ?e]] group))
+ (is (= '[[?a :a :b]
+ [?f :f ?a]
+ [?d :e ?f]
+ [?b :c ?d]
+ [?d :d ?e]
+ [?f :g ?g]
+ [?g :v1 ?v1]
+ [?g :v2 ?v2]
+ [?h :v1 ?v1]
+ [?h :v2 ?v2]
+ [?i :i ?h]
+ [?other :id "id"]] path))))