diff options
Diffstat (limited to 'models/nutrient-measurement.rkt')
| -rw-r--r-- | models/nutrient-measurement.rkt | 92 |
1 files changed, 38 insertions, 54 deletions
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt index 1cabf63..dbcb53c 100644 --- a/models/nutrient-measurement.rkt +++ b/models/nutrient-measurement.rkt @@ -66,7 +66,6 @@ ;; READ -(struct acc (measured-on pairs) #:transparent) (define joined (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm) (as nutrient_value_sets nvs) @@ -76,66 +75,51 @@ (as nutrients n) #:on (= n.id nv.nutrient_id)))) +(define (grouped-row->nutrient-measurement row) + (match-define (vector nm-id measured-on residuals) row) + (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) + (nutrient-measurement nm-id measured-on nutrient-value-pairs)) (define (get-nutrient-measurements) - (define query (select nm.id nm.measured_on - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nm.measured_on #:desc)) - (define rows (query-rows (current-conn) query)) - (define by-id - (for/fold ([h (hash)]) ([row (in-list rows)]) - (match-define (vector nm-id measured-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 nm-id - (λ (old-acc) - (acc (acc-measured-on old-acc) - (cons nv-pair (acc-pairs old-acc)))) - (λ () - (acc measured-on - (list nv-pair)))))) - (for/list ([(id a) (in-hash by-id)]) - (nutrient-measurement id - (acc-measured-on a) - (reverse (acc-pairs a))))) - -(define (get-nutrient-measurement #:id [nm-id #f] - #:measured-on [measured-on #f]) + (define grouped-rows (query-rows (current-conn) + (select nm.id + nm.measured_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nm.measured_on + #:desc) + #:group '#(0 1))) + (for/list ([row grouped-rows]) + (grouped-row->nutrient-measurement row))) + +(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f]) (define where (cond [(and nm-id measured-on) - (scalar-expr-qq (and (= nm.id ,nm-id) - (= nm.measured_on ,measured-on)))] - [nm-id - (scalar-expr-qq (= nm.id ,nm-id))] - [measured-on - (scalar-expr-qq (= nm.measured_on ,measured-on))])) - (define query (select nm.id nm.measured_on - n.id n.canonical_name n.formula + (scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))] + [nm-id (scalar-expr-qq (= nm.id ,nm-id))] + [measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))] + [else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (select nm.id + nm.measured_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 value rows belonging to the single nutrient measurement into one struct - (define the-id #f) - (define A #f) - (for ([row (in-list rows)]) - (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row) - (unless the-id (set! the-id nm-id)) - (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (set! A (if A - (acc (acc-measured-on A) - (cons nv-pair (acc-pairs A))) - (acc measured-on - (list nv-pair))))) - (and A - (nutrient-measurement the-id - (acc-measured-on A) - (reverse (acc-pairs A))))])) + #:where (ScalarExpr:AST ,where) + #:order-by nm.measured_on + #:desc) + #:group '#(0 1))) + (match grouped-rows + ['() #f] + [(list row) (grouped-row->nutrient-measurement row)] + [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))])) (define (get-nutrient-measurement-values nutrient-measurement) (for/list ([(nutrient-id name formula value_ppm) |