diff options
Diffstat (limited to 'models/nutrient-target.rkt')
| -rw-r--r-- | models/nutrient-target.rkt | 86 |
1 files changed, 36 insertions, 50 deletions
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index 77d0b4c..b9ca2d1 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -61,8 +61,6 @@ ;; READ -(struct acc (effective-on pairs) #:transparent) - (define joined (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt) (as nutrient_value_sets nvs) @@ -72,28 +70,24 @@ (as nutrients n) #:on (= n.id nv.nutrient_id)))) +(define (grouped-row->nutrient-target row) + (match-define (vector nt-id effective-on residuals) row) + (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) + (nutrient-target nt-id effective-on nutrient-value-pairs)) + (define (get-nutrient-targets) - (define query - (select nt.id - nt.effective_on - n.id - n.canonical_name - n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.effective_on - #:desc)) - (define rows (query-rows (current-conn) query)) - (define by-id - (for/fold ([h (hash)]) ([row (in-list rows)]) - (match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row) - (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (hash-update h - nt-id - (λ (old-acc) (acc (acc-effective-on old-acc) (cons nv-pair (acc-pairs old-acc)))) - (λ () (acc effective-on (list nv-pair)))))) - (for/list ([(id a) (in-hash by-id)]) - (nutrient-target id (acc-effective-on a) (reverse (acc-pairs a))))) + (for/list ([grouped-row (in-query (current-conn) + (select nt.id + nt.effective_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nt.effective_on + #:desc) + #:group '#(0 1))]) + (grouped-row->nutrient-target grouped-row))) (define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f]) (define where @@ -101,33 +95,25 @@ [(and nt-id effective-on) (scalar-expr-qq (and (= nt.id ,nt-id) (= nt.effective_on ,effective-on)))] [nt-id (scalar-expr-qq (= nt.id ,nt-id))] - [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))])) - (define query - (select nt.id - nt.effective_on - n.id - n.canonical_name - n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:where (ScalarExpr:AST ,where))) - (define rows (query-rows (current-conn) query)) - (cond - [(null? rows) #f] - [else - ;; Fold all nutrient rows belonging to the single target into one struct - (define the-id #f) - (define A #f) - (for ([row (in-list rows)]) - (match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row) - (unless the-id - (set! the-id nt-id)) - (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (set! A - (if A - (acc (acc-effective-on A) (cons nv-pair (acc-pairs A))) - (acc effective-on (list nv-pair))))) - (and A (nutrient-target the-id (acc-effective-on A) (reverse (acc-pairs A))))])) + [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))] + [else (error 'get-nutrient-target "either #:id or #:effective-on must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (select nt.id + nt.effective_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where) + #:order-by nt.effective_on + #:desc) + #:group '#(0 1))) + (match grouped-rows + ['() #f] + [(list row) (grouped-row->nutrient-target row)] + [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))])) (define (get-nutrient-target-values nutrient-target) (for/list ([(nutrient-id name formula value_ppm) |