diff options
| -rw-r--r-- | db/seed.rkt | 12 | ||||
| -rw-r--r-- | formlets.rkt | 13 | ||||
| -rw-r--r-- | handlers.rkt | 10 | ||||
| -rw-r--r-- | models/crop-requirement.rkt | 53 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 60 | ||||
| -rw-r--r-- | models/nutrient-measurement.rkt | 62 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 58 | ||||
| -rw-r--r-- | models/nutrient.rkt | 16 | ||||
| -rw-r--r-- | services/nnls.rkt | 5 | ||||
| -rw-r--r-- | tests/models/nutrient-measurement.rkt | 12 |
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))))))) |