query: auto-route group-by-aggregate to native columnar operator
ober
c4df9d1c811baebd58dda0385ad56c350144a892
--- a/lib/jerboa-db/query/engine.ss +++ b/lib/jerboa-db/query/engine.ss @@ -31,7 +31,8 @@ (jerboa-db query functions) (jerboa-db query aggregates) (jerboa-db query planner) - (jerboa-db query rules)) + (jerboa-db query rules) + (jerboa-db query group)) ;; ---- Cardinality estimator (planner input) ---- ;; (card-fn aid value) -> count of current datoms with that attribute id and @@ -1055,6 +1056,112 @@ (or (>= n 3) (and has-agg? (>= n 2)))))) + ;; ---- Native columnar group-by routing ---- + ;; Intercept the group-by-aggregate shapes the native operator handles so they + ;; run in-process (no DuckDB round-trip) with results identical to Datalog. + ;; Deliberately conservative: ($) inputs only, every clause a 3-element data + ;; pattern, exactly one group var + one supported aggregate, cardinality-one + ;; attributes, numeric value attribute for sum/avg/min/max, and not history + ;; mode (which returns all datoms, not current). Anything else falls through. + + (def (group-data-clause? c) + (and (pair? c) (not (pair? (car c))) (= (length c) 3) + (symbol? (cadr c)) (not (logic-var? (cadr c))))) + + (def (numeric-vtype? vt) + (memq vt '(db.type/long db.type/double db.type/instant db.type/ref))) + + (def (group-attr-card1? schema ident) + (let ([a (schema-lookup-by-ident schema ident)]) (and a (cardinality-one? a)))) + + (def (group-attr-numeric? schema ident) + (let ([a (schema-lookup-by-ident schema ident)]) + (and a (numeric-vtype? (db-attribute-value-type a))))) + + (def (group-attr-ref? schema ident) + (let ([a (schema-lookup-by-ident schema ident)]) (and a (ref-type? a)))) + + (def (group-find-clause clauses pred) + (cond [(null? clauses) #f] [(pred (car clauses)) (car clauses)] + [else (group-find-clause (cdr clauses) pred)])) + + ;; -> (values group-var agg-sym agg-var) or (#f #f #f) + (def (classify-group-find find-vars) + (let loop ([fvs find-vars] [gv #f] [gc 0] [asym #f] [avar #f] [ac 0]) + (cond + [(null? fvs) + (if (and (= gc 1) (= ac 1)) (values gv asym avar) (values #f #f #f))] + [(logic-var? (car fvs)) (loop (cdr fvs) (car fvs) (+ gc 1) asym avar ac)] + [(and (pair? (car fvs)) (= (length (car fvs)) 2) + (memq (car (car fvs)) '(count sum avg min max)) + (logic-var? (cadr (car fvs)))) + (loop (cdr fvs) gv gc (car (car fvs)) (cadr (car fvs)) (+ ac 1))] + [(not (pair? (car fvs))) (loop (cdr fvs) gv gc asym avar ac)] ;; literal + [else (values #f #f #f)]))) ;; unsupported + + ;; single-hop: (E GA G) (E VA V), group by G, aggregate V (or count entities) + (def (detect-group-two schema clauses gv agg av) + (let ([cA (car clauses)] [cB (cadr clauses)]) + (and (logic-var? (car cA)) (eq? (car cA) (car cB)) + (let ([ga-clause (cond [(eq? (caddr cA) gv) cA] [(eq? (caddr cB) gv) cB] [else #f])]) + (and ga-clause + (let* ([va-clause (if (eq? ga-clause cA) cB cA)] + [ga (cadr ga-clause)] [va (cadr va-clause)]) + (and (not (eq? ga va)) + (group-attr-card1? schema ga) (group-attr-card1? schema va) + (case agg + [(count) #t] + [(sum avg min max) + (and (eq? (caddr va-clause) av) (group-attr-numeric? schema va))] + [else #f]) + (list 'two ga va agg)))))))) + + ;; ref-hop: (T RA R) (R GA G) (T VA V), group by G via the ref, aggregate V + (def (detect-group-ref schema clauses gv agg av) + (and (memq agg '(sum avg min max)) + (let ([ga-clause (group-find-clause clauses (lambda (c) (eq? (caddr c) gv)))] + [va-clause (group-find-clause clauses (lambda (c) (eq? (caddr c) av)))]) + (and ga-clause va-clause (not (eq? ga-clause va-clause)) + (let* ([rr (car ga-clause)] [tt (car va-clause)] + [ref-clause (group-find-clause clauses + (lambda (c) (and (not (eq? c ga-clause)) + (not (eq? c va-clause)))))]) + (and (logic-var? rr) (logic-var? tt) (not (eq? rr tt)) + ref-clause + (eq? (car ref-clause) tt) (eq? (caddr ref-clause) rr) + (group-attr-ref? schema (cadr ref-clause)) + (group-attr-card1? schema (cadr ref-clause)) + (group-attr-card1? schema (cadr ga-clause)) + (group-attr-card1? schema (cadr va-clause)) + (group-attr-numeric? schema (cadr va-clause)) + (list 'ref (cadr ref-clause) (cadr ga-clause) (cadr va-clause) agg))))))) + + (def (native-group-descriptor schema find-vars in-vars where-clauses) + (and (equal? in-vars '($)) + (pair? where-clauses) + (for-all group-data-clause? where-clauses) + (let-values ([(gv agg av) (classify-group-find find-vars)]) + (and gv agg + (case (length where-clauses) + [(2) (detect-group-two schema where-clauses gv agg av)] + [(3) (detect-group-ref schema where-clauses gv agg av)] + [else #f]))))) + + (def (execute-native-group db desc find-vars) + (let ([alist (case (car desc) + [(two) (group-aggregate db (cadr desc) (caddr desc) (cadddr desc))] + [(ref) (group-aggregate-via-ref db (cadr desc) (caddr desc) + (cadddr desc) (car (cddddr desc)))])]) + (map (lambda (pair) + (let ([g (car pair)] [result (cdr pair)]) + (map (lambda (fv) + (cond + [(and (pair? fv) (aggregate? (car fv))) result] + [(logic-var? fv) g] + [else fv])) + find-vars))) + alist))) + ;; ---- Top-level query function ---- (def (query-db parsed db . inputs) @@ -1067,6 +1174,11 @@ (cond [pure-agg-desc (execute-pure-aggregate db pure-agg-desc)] + ;; Native columnar group-by (single-hop / one ref-hop) — beats the DuckDB + ;; round-trip and the general join, with identical results. + [(and (not (db-value-history? db)) + (native-group-descriptor schema find-vars in-vars where-clauses)) + => (lambda (desc) (execute-native-group db desc find-vars))] [(analytics-route-eligible? find-vars where-clauses) (let ([rows (apply *analytical-query-handler* parsed (current-analytics-engine) schema inputs)]) --- a/lib/jerboa-db/query/group.ss +++ b/lib/jerboa-db/query/group.ss @@ -18,7 +18,7 @@ ;;; Multi-hop grouping (e.g. via a ref) and auto-routing from `q` are follow-ons. (library (jerboa-db query group) - (export group-aggregate group-count) + (export group-aggregate group-count group-aggregate-via-ref) (import (except (chezscheme) make-hash-table hash-table? @@ -86,7 +86,7 @@ (case agg [(count) cnt] [(sum) sum] - [(avg) (if (= cnt 0) 0 (/ sum cnt))] + [(avg) (if (= cnt 0) 0 (inexact (/ sum cnt)))] ;; matches engine's avg [(min) mn] [(max) mx] [else (error 'group-aggregate "unknown aggregate" agg)]))) @@ -119,4 +119,29 @@ (def (group-count db group-attr) (group-aggregate db group-attr #f 'count)) + ;; One-ref-hop group-by (the real Q8 shape): the value entity T carries + ;; ref-attr (T -> R) and value-attr (T -> v); the group key is group-attr on + ;; the referenced entity R (R -> g). Aggregate v grouped by g. + ;; e.g. avg track/duration grouped by release/status, via track/release. + (def (group-aggregate-via-ref db ref-attr group-attr value-attr agg) + (let ([rgt (make-hashtable equal-hash equal?)] ;; R -> group value + [trt (make-hashtable equal-hash equal?)] ;; T -> R + [acc (make-hashtable equal-hash equal?)]) ;; group value -> cell + (for-each (lambda (d) (hashtable-set! rgt (datom-e d) (datom-v d))) + (current-datoms-for db (attr-id db group-attr))) + (for-each (lambda (d) (hashtable-set! trt (datom-e d) (datom-v d))) + (current-datoms-for db (attr-id db ref-attr))) + (let* ([vseg (make-segment (current-datoms-for db (attr-id db value-attr)))] + [n (segment-count vseg)]) + (let loop ([i 0]) + (when (< i n) + (let* ([t (segment-e vseg i)] + [r (hashtable-ref trt t #f)] + [g (and r (hashtable-ref rgt r #f))]) + (when g (cell-bump! acc g (segment-v vseg i)))) + (loop (+ i 1))))) + (let-values ([(ks vs) (hashtable-entries acc)]) + (map (lambda (g cell) (cons g (project-agg agg cell))) + (vector->list ks) (vector->list vs))))) + ) ;; end library --- a/tests/test-core.ss +++ b/tests/test-core.ss @@ -750,9 +750,41 @@ (let ([d (db conn)]) (assert-equal (sort-alist (group-count d 'g/cat)) '(("a" . 2) ("b" . 1))) (assert-equal (sort-alist (group-aggregate d 'g/cat 'g/val 'sum)) '(("a" . 30) ("b" . 100))) - (assert-equal (sort-alist (group-aggregate d 'g/cat 'g/val 'avg)) '(("a" . 15) ("b" . 100))) + (assert-equal (sort-alist (group-aggregate d 'g/cat 'g/val 'avg)) '(("a" . 15.0) ("b" . 100.0))) (assert-equal (sort-alist (group-aggregate d 'g/cat 'g/val 'max)) '(("a" . 20) ("b" . 100)))))) +(test "q auto-routes 2-clause group-by-aggregate" + (let ([conn (connect ":memory:")] + [sr (lambda (rs) (list-sort (lambda (x y) (string<? (car x) (car y))) rs))]) + (transact! conn + (list '((db/ident . g/cat) (db/valueType . db.type/string) (db/cardinality . db.cardinality/one)) + '((db/ident . g/val) (db/valueType . db.type/long) (db/cardinality . db.cardinality/one)))) + (transact! conn + (list '((g/cat . "a") (g/val . 10)) '((g/cat . "a") (g/val . 20)) '((g/cat . "b") (g/val . 100)))) + (let ([d (db conn)]) + (assert-equal (sr (q '((find ?c (sum ?v)) (where (?e g/cat ?c) (?e g/val ?v))) d)) + '(("a" 30) ("b" 100))) + (assert-equal (sr (q '((find ?c (count ?e)) (where (?e g/cat ?c) (?e g/val ?v))) d)) + '(("a" 2) ("b" 1)))))) + +(test "q auto-routes ref-hop group-by (Q8 shape)" + (let ([conn (connect ":memory:")] + [sr (lambda (rs) (list-sort (lambda (x y) (string<? (car x) (car y))) rs))]) + (transact! conn + (list '((db/ident . r/status) (db/valueType . db.type/string) (db/cardinality . db.cardinality/one)) + '((db/ident . t/rel) (db/valueType . db.type/ref) (db/cardinality . db.cardinality/one)) + '((db/ident . t/d) (db/valueType . db.type/long) (db/cardinality . db.cardinality/one)))) + (transact! conn (list '((r/status . "x")) '((r/status . "y")))) + (let* ([rs (q '((find ?r ?s) (where (?r r/status ?s))) (db conn))] + [rx (caar (filter (lambda (row) (string=? (cadr row) "x")) rs))] + [ry (caar (filter (lambda (row) (string=? (cadr row) "y")) rs))]) + (transact! conn (list `((t/rel . ,rx) (t/d . 10)) + `((t/rel . ,rx) (t/d . 20)) + `((t/rel . ,ry) (t/d . 5)))) + (assert-equal + (sr (q '((find ?s (sum ?dd)) (where (?t t/rel ?r) (?r r/status ?s) (?t t/d ?dd))) (db conn))) + '(("x" 30) ("y" 5)))))) + ;; ============================================================ ;; Report ;; ============================================================