Replace nutrient-value alists with hashes everywhere.

5 files changed, 122 insertions, 127 deletions

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