summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Peter <dev@marius-peter.com>2025-11-20 14:08:21 +0100
committerMarius Peter <dev@marius-peter.com>2025-11-20 14:08:21 +0100
commitd2b7a6a7e2739869f8b718c80cad7c9515f10070 (patch)
treed3e8ac04dc4d1178fe24bc0511ada49caadf25db
parent434b521ddb70287b55d1dc8f5e24f18aeaa01fdc (diff)
Replace nutrient-value alists with hashes everywhere.
Diffstat
-rw-r--r--db/seed.rkt12
-rw-r--r--formlets.rkt13
-rw-r--r--handlers.rkt10
-rw-r--r--models/crop-requirement.rkt53
-rw-r--r--models/fertilizer-product.rkt60
-rw-r--r--models/nutrient-measurement.rkt62
-rw-r--r--models/nutrient-target.rkt58
-rw-r--r--models/nutrient.rkt16
-rw-r--r--services/nnls.rkt5
-rw-r--r--tests/models/nutrient-measurement.rkt12
10 files changed, 145 insertions, 156 deletions
diff --git a/db/seed.rkt b/db/seed.rkt
index 881b9ef..7176c89 100644
--- a/db/seed.rkt
+++ b/db/seed.rkt
@@ -50,11 +50,11 @@
(define row-alist (map cons header row))
(define measured-on (cdr (first row-alist)))
(define nutrient-values
- (for/list ([nm (in-list (cdr row-alist))])
+ (for/hash ([nm (in-list (cdr row-alist))])
(define formula (car nm))
(define n (get-nutrient #:formula formula))
(define v (string->number (cdr nm)))
- (cons n v)))
+ (values n v)))
(create-nutrient-measurement! measured-on nutrient-values))
(with-tx (csv-for-each row->seed! next-row)))
@@ -75,11 +75,11 @@
(define crop-name (string-downcase (cdr (assoc "Plante" row-alist))))
(define profile (cdr (assoc "Profil" row-alist)))
(define nutrient-values
- (for/list ([crop-requirement (in-list (list-tail row-alist 2))])
+ (for/hash ([crop-requirement (in-list (list-tail row-alist 2))])
(define formula (car crop-requirement))
(define n (get-nutrient #:formula formula))
(define v (string->number (cdr crop-requirement)))
- (cons n v)))
+ (values n v)))
(cond
[(non-empty-string? crop-name)
(define crop (get-crop #:name crop-name))
@@ -96,11 +96,11 @@
(define canonical-name (cdr (assoc "Libellé" row-alist)))
(define brand-name (cdr (assoc "Nom commercial" row-alist)))
(define nutrient-values
- (for/list ([fertilizer-component (in-list (list-tail row-alist 3))])
+ (for/hash ([fertilizer-component (in-list (list-tail row-alist 3))])
(define formula (car fertilizer-component))
(define n (get-nutrient #:formula formula))
(define v (string->number (cdr fertilizer-component)))
- (cons n v)))
+ (values n v)))
(cond
[(non-empty-string? brand-name)
(create-fertilizer-product! canonical-name nutrient-values brand-name)]
diff --git a/formlets.rkt b/formlets.rkt
index 20a84d8..d0baffc 100644
--- a/formlets.rkt
+++ b/formlets.rkt
@@ -65,10 +65,10 @@
(format "~a (~a)" crop profile)
(format "~a" profile))))
(formlet
- (#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-proportion-b} ,input-label))
- (let ([requirement-proportion
- (string->number (bytes->string/utf-8 (binding:form-value requirement-proportion-b)))])
- (and requirement-proportion (cons requirement requirement-proportion)))))
+ (#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-percentage-b} ,input-label))
+ (let ([requirement-percentage
+ (string->number (bytes->string/utf-8 (binding:form-value requirement-percentage-b)))])
+ (and requirement-percentage (cons requirement requirement-percentage)))))
(define (targets-formlet)
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date ciblée") ,{=>* date-formlet effective-on*})
@@ -78,5 +78,6 @@
{=>* (crop-requirement-formlet requirement) requirements*}))
{=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
(let ([effective-on (first effective-on*)]
- [requirements (filter pair? requirements*)]) ; drop #f’s from empty values
- (values effective-on requirements))))
+ [nutrient-values (average-crop-requirement-nutrient-values (filter pair?
+ requirements*))])
+ (values effective-on nutrient-values))))
diff --git a/handlers.rkt b/handlers.rkt
index da56161..6104b66 100644
--- a/handlers.rkt
+++ b/handlers.rkt
@@ -34,10 +34,7 @@
(define latest-measurements (take (get-nutrient-measurements) 10))
(response/xexpr
#:preamble #"<!DOCTYPE html>"
- (ferti-page ferti-recipe
- latest-measurement-hash
- latest-target-hash
- latest-measurements)))
+ (ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements)))
(define (index _)
(define user (get-current-user))
@@ -63,9 +60,8 @@
(response/xexpr #:preamble #"<!DOCTYPE html>" (new-target-page)))
(define (create-target req)
- (define-values (effective-on crop-requirement-mix) (formlet-process (targets-formlet) req))
- (define target-nutrient-values (average-crop-requirement-nutrient-values crop-requirement-mix))
- (create-nutrient-target! effective-on target-nutrient-values)
+ (define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req))
+ (create-nutrient-target! effective-on nutrient-values)
(redirect-to "/"))
(define (fallback _)
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index 2048091..7d7b5aa 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -6,20 +6,19 @@
crop-requirement-profile
crop-requirement-crop-id
(rename-out [crop-requirement-nutrient-values crop-requirement-values])
- (contract-out
- [create-crop-requirement!
- (->* (string? (listof nutrient-value-pair/c)) ((or/c #f crop?)) crop-requirement?)]
- [get-crop-requirements (-> (listof crop-requirement?))]
- [get-crop-requirement
- (->* ()
- (#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
- (or/c crop-requirement? #f))]
- [get-crop-requirement-values (-> crop-requirement? (listof nutrient-value-pair/c))]
- [get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
- [delete-crop-requirement! (-> crop-requirement? void?)]
- [average-crop-requirement-nutrient-values
- (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
- (listof nutrient-value-pair/c))]))
+ (contract-out [create-crop-requirement!
+ (->* (string? nutrient-value-hash/c) ((or/c #f crop?)) crop-requirement?)]
+ [get-crop-requirements (-> (listof crop-requirement?))]
+ [get-crop-requirement
+ (->* ()
+ (#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
+ (or/c crop-requirement? #f))]
+ [get-crop-requirement-values (-> crop-requirement? nutrient-value-hash/c)]
+ [get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
+ [delete-crop-requirement! (-> crop-requirement? void?)]
+ [average-crop-requirement-nutrient-values
+ (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
+ nutrient-value-hash/c)]))
(require racket/contract
db
@@ -50,8 +49,7 @@
(define nvs-id
(query-value (current-conn)
(select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id))))
- (for ([nv nutrient-values])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash nutrient-values)])
(query-exec (current-conn)
(insert #:into nutrient_values
#:set [value_set_id ,nvs-id]
@@ -72,8 +70,7 @@
(define (grouped-row->crop-requirement row)
(match-define (vector cr-id profile crop-id residuals) row)
- (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
- (crop-requirement cr-id profile crop-id nutrient-value-pairs))
+ (crop-requirement cr-id profile crop-id (residuals->nutrient-value-hash residuals)))
(define (get-crop-requirements)
(define grouped-rows
@@ -121,7 +118,7 @@
[many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
(define (get-crop-requirement-values crop-requirement)
- (for/list ([(nutrient-id name formula value_ppm)
+ (for/hash ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
@@ -129,7 +126,7 @@
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= cr.id ,(crop-requirement-id crop-requirement))))])
- (cons (nutrient nutrient-id name formula) value_ppm)))
+ (values (nutrient nutrient-id name formula) value_ppm)))
(define (get-crop-requirement-value crop-requirement nutrient)
(query-maybe-value (current-conn)
@@ -149,12 +146,10 @@
;; Helpers
(define (average-crop-requirement-nutrient-values mix)
- (define average-values
- (for/fold ([acc (hash)]) ([pair (in-list mix)])
- (match-define (cons crop-requirement percentage) pair)
- (for/fold ([acc acc]) ([nv (in-list (get-crop-requirement-values crop-requirement))])
- (match-define (cons n v) nv)
- (define nutrient-contribution (* v (/ percentage 100)))
- (hash-update acc n (λ (old) (+ old nutrient-contribution)) (λ () nutrient-contribution)))))
- (for/list ([(n v) (in-hash average-values)])
- (cons n v)))
+ (for/fold ([acc (hash)]) ([pair (in-list mix)])
+ (match-define (cons crop-requirement percentage) pair)
+ (define weight (/ percentage 100.0))
+ (for/fold ([acc acc])
+ ([(nutrient value) (in-hash (crop-requirement-nutrient-values crop-requirement))])
+ (define contribution (* value weight))
+ (hash-update acc nutrient (λ (old) (+ old contribution)) (λ () contribution)))))
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index 1d6adbb..f9965c2 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -6,17 +6,17 @@
(rename-out [fertilizer-product-canonical-name fertilizer-name]
[fertilizer-product-nutrient-values fertilizer-product-values]
[fertilizer-product-brand-name fertilizer-brand-name])
- (contract-out
- [create-fertilizer-product!
- (->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)]
- [get-fertilizer-products (-> (listof fertilizer-product?))]
- [get-fertilizer-product
- (->* ()
- (#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
- (or/c fertilizer-product? #f))]
- [get-fertilizer-product-values (-> fertilizer-product? (listof nutrient-value-pair/c))]
- [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
- [delete-fertilizer-product! (-> fertilizer-product? void?)]))
+ (contract-out [create-fertilizer-product!
+ (->* (string? nutrient-value-hash/c) (string?) fertilizer-product?)]
+ [get-fertilizer-products (-> (listof fertilizer-product?))]
+ [get-fertilizer-product
+ (->* ()
+ (#:id (or/c #f exact-nonnegative-integer?)
+ #:canonical-name (or/c #f string?))
+ (or/c fertilizer-product? #f))]
+ [get-fertilizer-product-values (-> fertilizer-product? nutrient-value-hash/c)]
+ [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
+ [delete-fertilizer-product! (-> fertilizer-product? void?)]))
(require racket/contract
db
@@ -37,8 +37,7 @@
(fertilizer-product-canonical-name v)
(fertilizer-product-brand-name v))
(fprintf out "~a\n" (fertilizer-product-canonical-name v)))
- (for ([nv (in-list (fertilizer-product-nutrient-values v))])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash (fertilizer-product-nutrient-values v))])
(fprintf out
"~a ~a\n"
(~a (nutrient-name n) #:min-width 14)
@@ -65,8 +64,7 @@
(define nvs-id
(query-value (current-conn)
(select id #:from nutrient_value_sets #:where (= fertilizer_product_id ,fp-id))))
- (for ([nv nutrient-values])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash nutrient-values)])
(query-exec (current-conn)
(insert #:into nutrient_values
#:set [value_set_id ,nvs-id]
@@ -87,22 +85,22 @@
(define (grouped-row->fertilizer-product row)
(match-define (vector fp-id canonical-name brand-name residuals) row)
- (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
- (fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name))
+ (fertilizer-product fp-id canonical-name (residuals->nutrient-value-hash residuals) brand-name))
(define (get-fertilizer-products)
- (define grouped-rows (query-rows (current-conn)
- (select fp.id
- fp.canonical_name
- fp.brand_name
- n.id
- n.canonical_name
- n.formula
- nv.value_ppm
- #:from (TableExpr:AST ,joined)
- #:order-by fp.canonical_name
- #:asc)
- #:group '#(0 1 2)))
+ (define grouped-rows
+ (query-rows (current-conn)
+ (select fp.id
+ fp.canonical_name
+ fp.brand_name
+ n.id
+ n.canonical_name
+ n.formula
+ nv.value_ppm
+ #:from (TableExpr:AST ,joined)
+ #:order-by fp.canonical_name
+ #:asc)
+ #:group '#(0 1 2)))
(for/list ([row grouped-rows])
(grouped-row->fertilizer-product row)))
@@ -134,7 +132,7 @@
[many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
(define (get-fertilizer-product-values fertilizer-product)
- (for/list ([(nutrient-id name formula value_ppm)
+ (for/hash ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
@@ -142,7 +140,7 @@
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
- (cons (nutrient nutrient-id name formula) value_ppm)))
+ (values (nutrient nutrient-id name formula) value_ppm)))
(define (get-fertilizer-product-value fertilizer-product nutrient)
(query-maybe-value (current-conn)
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 199208f..fa1171c 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -6,14 +6,13 @@
(rename-out [nutrient-measurement-measured-on nutrient-measurement-date]
[nutrient-measurement-nutrient-values nutrient-measurement-values])
(contract-out
- [create-nutrient-measurement!
- (-> string? (listof nutrient-value-pair/c) nutrient-measurement?)]
+ [create-nutrient-measurement! (-> string? nutrient-value-hash/c nutrient-measurement?)]
[get-nutrient-measurements (-> (listof nutrient-measurement?))]
[get-nutrient-measurement
(->* ()
(#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?))
(or/c nutrient-measurement? #f))]
- [get-nutrient-measurement-values (-> nutrient-measurement? (listof nutrient-value-pair/c))]
+ [get-nutrient-measurement-values (-> nutrient-measurement? nutrient-value-hash/c)]
[get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)]
[get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))]
[get-latest-nutrient-measurement-hash (-> (hash/c nutrient? number?))]
@@ -33,8 +32,7 @@
"Measurement #~a on ~a\n"
(nutrient-measurement-id v)
(nutrient-measurement-measured-on v))
- (for ([nv (nutrient-measurement-nutrient-values v)])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash (nutrient-measurement-nutrient-values v))])
(fprintf out
"~a ~a\n"
(~a (nutrient-name n) #:min-width 14)
@@ -55,8 +53,7 @@
(define nvs-id
(query-value (current-conn)
(select id #:from nutrient_value_sets #:where (= nutrient_measurement_id ,nm-id))))
- (for ([nv nutrient-values])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash nutrient-values)])
(query-exec (current-conn)
(insert #:into nutrient_values
#:set [value_set_id ,nvs-id]
@@ -77,21 +74,21 @@
(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))
+ (nutrient-measurement nm-id measured-on (residuals->nutrient-value-hash residuals)))
(define (get-nutrient-measurements)
- (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)))
+ (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)))
@@ -122,7 +119,7 @@
[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)
+ (for/hash ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
@@ -130,7 +127,7 @@
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
- (cons (nutrient nutrient-id name formula) value_ppm)))
+ (values (nutrient nutrient-id name formula) value_ppm)))
(define (get-nutrient-measurement-value nutrient-measurement nutrient)
(query-maybe-value (current-conn)
@@ -149,17 +146,16 @@
#:limit 1)))
(define (get-latest-nutrient-measurement-hash)
- (for/hash ([(n-id n-name n-formula residual-rows)
- (in-query (current-conn)
- (select n.id
- n.canonical_name
- n.formula
- nm.measured_on
- nv.value_ppm
- #:from (TableExpr:AST ,joined)
- #:order-by nm.measured_on
- #:desc)
- #:group '(#(0 1 2)))])
+ (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
+ (select n.id
+ n.canonical_name
+ n.formula
+ nm.measured_on
+ nv.value_ppm
+ #:from (TableExpr:AST ,joined)
+ #:order-by nm.measured_on
+ #:desc)
+ #:group '(#(0 1 2)))])
;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm)
(match-define (vector _measured-on value-ppm) (first residual-rows))
(values (nutrient n-id n-name n-formula) value-ppm)))
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt
index 261fce0..a19ca6a 100644
--- a/models/nutrient-target.rkt
+++ b/models/nutrient-target.rkt
@@ -5,18 +5,18 @@
nutrient-target-id
(rename-out [nutrient-target-effective-on nutrient-target-date]
[nutrient-target-nutrient-values nutrient-target-values])
- (contract-out
- [create-nutrient-target! (-> string? (listof nutrient-value-pair/c) nutrient-target?)]
- [get-nutrient-targets (-> (listof nutrient-target?))]
- [get-nutrient-target
- (->* ()
- (#:id (or/c #f exact-nonnegative-integer?) #:effective-on (or/c #f string?))
- (or/c nutrient-target? #f))]
- [get-nutrient-target-values (-> nutrient-target? (listof nutrient-value-pair/c))]
- [get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
- [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
- [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))]
- [delete-nutrient-target! (-> nutrient-target? void?)]))
+ (contract-out [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
+ [get-nutrient-targets (-> (listof nutrient-target?))]
+ [get-nutrient-target
+ (->* ()
+ (#:id (or/c #f exact-nonnegative-integer?)
+ #:effective-on (or/c #f string?))
+ (or/c nutrient-target? #f))]
+ [get-nutrient-target-values (-> nutrient-target? nutrient-value-hash/c)]
+ [get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
+ [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
+ [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))]
+ [delete-nutrient-target! (-> nutrient-target? void?)]))
(require racket/contract
db
@@ -29,8 +29,7 @@
#:property prop:custom-write
(λ (v out _)
(fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-effective-on v))
- (for ([nv (nutrient-target-nutrient-values v)])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash (nutrient-target-nutrient-values v))])
(fprintf out
"~a ~a\n"
(~a (nutrient-name n) #:min-width 14)
@@ -50,8 +49,7 @@
(define nvs-id
(query-value (current-conn)
(select id #:from nutrient_value_sets #:where (= nutrient_target_id ,nt-id))))
- (for ([nv nutrient-values])
- (match-define (cons n v) nv)
+ (for ([(n v) (in-hash nutrient-values)])
(query-exec (current-conn)
(insert #:into nutrient_values
#:set [value_set_id ,nvs-id]
@@ -72,8 +70,7 @@
(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))
+ (nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals)))
(define (get-nutrient-targets)
(for/list ([grouped-row (in-query (current-conn)
@@ -116,7 +113,7 @@
[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)
+ (for/hash ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
@@ -124,7 +121,7 @@
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= nt.id ,(nutrient-target-id nutrient-target))))])
- (cons (nutrient nutrient-id name formula) value_ppm)))
+ (values (nutrient nutrient-id name formula) value_ppm)))
(define (get-nutrient-target-value nutrient-target nutrient)
(query-maybe-value (current-conn)
@@ -143,17 +140,16 @@
#:limit 1)))
(define (get-latest-nutrient-target-hash)
- (for/hash ([(n-id n-name n-formula residual-rows)
- (in-query (current-conn)
- (select n.id
- n.canonical_name
- n.formula
- nt.effective_on
- nv.value_ppm
- #:from (TableExpr:AST ,joined)
- #:order-by nt.effective_on
- #:desc)
- #:group '(#(0 1 2)))])
+ (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
+ (select n.id
+ n.canonical_name
+ n.formula
+ nt.effective_on
+ nv.value_ppm
+ #:from (TableExpr:AST ,joined)
+ #:order-by nt.effective_on
+ #:desc)
+ #:group '(#(0 1 2)))])
;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm)
(match-define (vector _effective-on value-ppm) (first residual-rows))
(values (nutrient n-id n-name n-formula) value-ppm)))
diff --git a/models/nutrient.rkt b/models/nutrient.rkt
index 91be68f..d79801f 100644
--- a/models/nutrient.rkt
+++ b/models/nutrient.rkt
@@ -5,7 +5,7 @@
nutrient-id
nutrient-name
nutrient-formula
- nutrient-value-pair/c
+ nutrient-value-hash/c
(contract-out [create-nutrient! (-> string? string? nutrient?)]
[get-nutrients (-> (listof nutrient?))]
[get-nutrient
@@ -18,7 +18,9 @@
(->* (nutrient?)
(#:name (or/c #f string?) #:formula (or/c #f string?))
(or/c nutrient? #f))]
- [delete-nutrient! (-> nutrient? void?)]))
+ [delete-nutrient! (-> nutrient? void?)]
+ [residuals->nutrient-value-hash
+ (-> (listof residual-vector/c) nutrient-value-hash/c)]))
(require racket/contract
db
@@ -30,7 +32,15 @@
#:property prop:custom-write
(λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
-(define nutrient-value-pair/c (cons/c nutrient? (and/c real? (>=/c 0))))
+(define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t))
+
+;; vector/c id, nutrient name, nutrient formula, value (ppm)
+(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?))
+
+(define (residuals->nutrient-value-hash residuals)
+ (for/hash ([r (in-list residuals)])
+ (match-define (vector n-id n-name n-formula value-ppm) r)
+ (values (nutrient n-id n-name n-formula) value-ppm)))
;; CREATE
diff --git a/services/nnls.rkt b/services/nnls.rkt
index 96d37ec..16703d2 100644
--- a/services/nnls.rkt
+++ b/services/nnls.rkt
@@ -176,10 +176,7 @@
(λ (i j)
(define selected-nutrient (list-ref nutrients i))
(define product (list-ref fertilizers j))
- (define pair (assoc selected-nutrient (fertilizer-product-values product)))
- (if pair
- (cdr pair)
- 0))))
+ (hash-ref (fertilizer-product-values product) selected-nutrient 0))))
(module+ test
(require rackunit
diff --git a/tests/models/nutrient-measurement.rkt b/tests/models/nutrient-measurement.rkt
index c0c1ee1..ed9e750 100644
--- a/tests/models/nutrient-measurement.rkt
+++ b/tests/models/nutrient-measurement.rkt
@@ -24,7 +24,7 @@
(test-case "Create measurement with date and values"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define phosphorus (get-nutrient #:name "Phosphorus"))
- (create-nutrient-measurement! measurement-date `((,nitrogen . 12.3) (,phosphorus . 4.5)))
+ (create-nutrient-measurement! measurement-date (hash nitrogen 12.3 phosphorus 4.5))
(check-equal? (length (get-nutrient-measurements)) 1)
(define nm (get-nutrient-measurement #:measured-on measurement-date))
(check-true (nutrient-measurement? nm))
@@ -43,15 +43,15 @@
(get-nutrient-measurement-values nm)
nmv
"return value of get-nutrient-measurement-values ≠ nutrient-measurement-values struct accessor")
- (check-equal? (length nmv) 2)
- (check-equal? (cdr (assoc nitrogen nmv)) 12.3)
- (check-equal? (cdr (assoc phosphorus nmv)) 4.5))
+ (check-equal? (hash-count nmv) 2)
+ (check-equal? (hash-ref nmv nitrogen) 12.3)
+ (check-equal? (hash-ref nmv phosphorus) 4.5))
(test-case "Retrieve latest measurement values"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define phosphorus (get-nutrient #:name "Phosphorus"))
(define second-measurement-date "2025-09-02")
- (create-nutrient-measurement! second-measurement-date `((,nitrogen . 6.7) (,phosphorus . 8.9)))
+ (create-nutrient-measurement! second-measurement-date (hash nitrogen 6.7 phosphorus 8.9))
(check-equal? (get-latest-nutrient-measurement-value nitrogen) 6.7)
(check-equal? (get-latest-nutrient-measurement-value phosphorus) 8.9))
@@ -63,4 +63,4 @@
(check-equal? (length (get-nutrient-measurements))
1
"wrong number of nutrient measurements were deleted")
- (check-true (null? (get-nutrient-measurement-values nm)))))))
+ (check-true (hash-empty? (get-nutrient-measurement-values nm)))))))
Copyright 2019--2026 Marius PETER