Replace nutrient-value alists with hashes everywhere.

1 files changed, 24 insertions, 29 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)))))