[Racket] Ferti hydroponic nutrient solver, redux.
Replace nutrient-value alists with hashes everywhere.
Changed files
db/seed.rkt
@@ -50,11 +50,11 @@
50
50
(define row-alist (map cons header row))
51
51
(define measured-on (cdr (first row-alist)))
52
52
(define nutrient-values
53
Removed:
(for/list ([nm (in-list (cdr row-alist))])
53
Added:
(for/hash ([nm (in-list (cdr row-alist))])
54
54
(define formula (car nm))
55
55
(define n (get-nutrient #:formula formula))
56
56
(define v (string->number (cdr nm)))
57
Removed:
(cons n v)))
57
Added:
(values n v)))
58
58
(create-nutrient-measurement! measured-on nutrient-values))
59
59
(with-tx (csv-for-each row->seed! next-row)))
60
60
@@ -75,11 +75,11 @@
75
75
(define crop-name (string-downcase (cdr (assoc "Plante" row-alist))))
76
76
(define profile (cdr (assoc "Profil" row-alist)))
77
77
(define nutrient-values
78
Removed:
(for/list ([crop-requirement (in-list (list-tail row-alist 2))])
78
Added:
(for/hash ([crop-requirement (in-list (list-tail row-alist 2))])
79
79
(define formula (car crop-requirement))
80
80
(define n (get-nutrient #:formula formula))
81
81
(define v (string->number (cdr crop-requirement)))
82
Removed:
(cons n v)))
82
Added:
(values n v)))
83
83
(cond
84
84
[(non-empty-string? crop-name)
85
85
(define crop (get-crop #:name crop-name))
@@ -96,11 +96,11 @@
96
96
(define canonical-name (cdr (assoc "Libellé" row-alist)))
97
97
(define brand-name (cdr (assoc "Nom commercial" row-alist)))
98
98
(define nutrient-values
99
Removed:
(for/list ([fertilizer-component (in-list (list-tail row-alist 3))])
99
Added:
(for/hash ([fertilizer-component (in-list (list-tail row-alist 3))])
100
100
(define formula (car fertilizer-component))
101
101
(define n (get-nutrient #:formula formula))
102
102
(define v (string->number (cdr fertilizer-component)))
103
Removed:
(cons n v)))
103
Added:
(values n v)))
104
104
(cond
105
105
[(non-empty-string? brand-name)
106
106
(create-fertilizer-product! canonical-name nutrient-values brand-name)]
formlets.rkt
@@ -65,10 +65,10 @@
65
65
(format "~a (~a)" crop profile)
66
66
(format "~a" profile))))
67
67
(formlet
68
Removed:
(#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-proportion-b} ,input-label))
69
Removed:
(let ([requirement-proportion
70
Removed:
(string->number (bytes->string/utf-8 (binding:form-value requirement-proportion-b)))])
71
Removed:
(and requirement-proportion (cons requirement requirement-proportion)))))
68
Added:
(#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-percentage-b} ,input-label))
69
Added:
(let ([requirement-percentage
70
Added:
(string->number (bytes->string/utf-8 (binding:form-value requirement-percentage-b)))])
71
Added:
(and requirement-percentage (cons requirement requirement-percentage)))))
72
72
73
73
(define (targets-formlet)
74
74
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date ciblée") ,{=>* date-formlet effective-on*})
@@ -78,5 +78,6 @@
78
78
{=>* (crop-requirement-formlet requirement) requirements*}))
79
79
{=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
80
80
(let ([effective-on (first effective-on*)]
81
Removed:
[requirements (filter pair? requirements*)]) ; drop #f’s from empty values
82
Removed:
(values effective-on requirements))))
81
Added:
[nutrient-values (average-crop-requirement-nutrient-values (filter pair?
82
Added:
requirements*))])
83
Added:
(values effective-on nutrient-values))))
handlers.rkt
@@ -34,10 +34,7 @@
34
34
(define latest-measurements (take (get-nutrient-measurements) 10))
35
35
(response/xexpr
36
36
#:preamble #"<!DOCTYPE html>"
37
Removed:
(ferti-page ferti-recipe
38
Removed:
latest-measurement-hash
39
Removed:
latest-target-hash
40
Removed:
latest-measurements)))
37
Added:
(ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements)))
41
38
42
39
(define (index _)
43
40
(define user (get-current-user))
@@ -63,9 +60,8 @@
63
60
(response/xexpr #:preamble #"<!DOCTYPE html>" (new-target-page)))
64
61
65
62
(define (create-target req)
66
Removed:
(define-values (effective-on crop-requirement-mix) (formlet-process (targets-formlet) req))
67
Removed:
(define target-nutrient-values (average-crop-requirement-nutrient-values crop-requirement-mix))
68
Removed:
(create-nutrient-target! effective-on target-nutrient-values)
63
Added:
(define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req))
64
Added:
(create-nutrient-target! effective-on nutrient-values)
69
65
(redirect-to "/"))
70
66
71
67
(define (fallback _)
models/crop-requirement.rkt
@@ -6,20 +6,19 @@
6
6
crop-requirement-profile
7
7
crop-requirement-crop-id
8
8
(rename-out [crop-requirement-nutrient-values crop-requirement-values])
9
Removed:
(contract-out
10
Removed:
[create-crop-requirement!
11
Removed:
(->* (string? (listof nutrient-value-pair/c)) ((or/c #f crop?)) crop-requirement?)]
12
Removed:
[get-crop-requirements (-> (listof crop-requirement?))]
13
Removed:
[get-crop-requirement
14
Removed:
(->* ()
15
Removed:
(#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
16
Removed:
(or/c crop-requirement? #f))]
17
Removed:
[get-crop-requirement-values (-> crop-requirement? (listof nutrient-value-pair/c))]
18
Removed:
[get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
19
Removed:
[delete-crop-requirement! (-> crop-requirement? void?)]
20
Removed:
[average-crop-requirement-nutrient-values
21
Removed:
(-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
22
Removed:
(listof nutrient-value-pair/c))]))
9
Added:
(contract-out [create-crop-requirement!
10
Added:
(->* (string? nutrient-value-hash/c) ((or/c #f crop?)) crop-requirement?)]
11
Added:
[get-crop-requirements (-> (listof crop-requirement?))]
12
Added:
[get-crop-requirement
13
Added:
(->* ()
14
Added:
(#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
15
Added:
(or/c crop-requirement? #f))]
16
Added:
[get-crop-requirement-values (-> crop-requirement? nutrient-value-hash/c)]
17
Added:
[get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
18
Added:
[delete-crop-requirement! (-> crop-requirement? void?)]
19
Added:
[average-crop-requirement-nutrient-values
20
Added:
(-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
21
Added:
nutrient-value-hash/c)]))
23
22
24
23
(require racket/contract
25
24
db
@@ -50,8 +49,7 @@
50
49
(define nvs-id
51
50
(query-value (current-conn)
52
51
(select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id))))
53
Removed:
(for ([nv nutrient-values])
54
Removed:
(match-define (cons n v) nv)
52
Added:
(for ([(n v) (in-hash nutrient-values)])
55
53
(query-exec (current-conn)
56
54
(insert #:into nutrient_values
57
55
#:set [value_set_id ,nvs-id]
@@ -72,8 +70,7 @@
72
70
73
71
(define (grouped-row->crop-requirement row)
74
72
(match-define (vector cr-id profile crop-id residuals) row)
75
Removed:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
76
Removed:
(crop-requirement cr-id profile crop-id nutrient-value-pairs))
73
Added:
(crop-requirement cr-id profile crop-id (residuals->nutrient-value-hash residuals)))
77
74
78
75
(define (get-crop-requirements)
79
76
(define grouped-rows
@@ -121,7 +118,7 @@
121
118
[many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
122
119
123
120
(define (get-crop-requirement-values crop-requirement)
124
Removed:
(for/list ([(nutrient-id name formula value_ppm)
121
Added:
(for/hash ([(nutrient-id name formula value_ppm)
125
122
(in-query (current-conn)
126
123
(select n.id
127
124
n.canonical_name
@@ -129,7 +126,7 @@
129
126
nv.value_ppm
130
127
#:from (TableExpr:AST ,joined)
131
128
#:where (= cr.id ,(crop-requirement-id crop-requirement))))])
132
Removed:
(cons (nutrient nutrient-id name formula) value_ppm)))
129
Added:
(values (nutrient nutrient-id name formula) value_ppm)))
133
130
134
131
(define (get-crop-requirement-value crop-requirement nutrient)
135
132
(query-maybe-value (current-conn)
@@ -149,12 +146,10 @@
149
146
;; Helpers
150
147
151
148
(define (average-crop-requirement-nutrient-values mix)
152
Removed:
(define average-values
153
Removed:
(for/fold ([acc (hash)]) ([pair (in-list mix)])
154
Removed:
(match-define (cons crop-requirement percentage) pair)
155
Removed:
(for/fold ([acc acc]) ([nv (in-list (get-crop-requirement-values crop-requirement))])
156
Removed:
(match-define (cons n v) nv)
157
Removed:
(define nutrient-contribution (* v (/ percentage 100)))
158
Removed:
(hash-update acc n (λ (old) (+ old nutrient-contribution)) (λ () nutrient-contribution)))))
159
Removed:
(for/list ([(n v) (in-hash average-values)])
160
Removed:
(cons n v)))
149
Added:
(for/fold ([acc (hash)]) ([pair (in-list mix)])
150
Added:
(match-define (cons crop-requirement percentage) pair)
151
Added:
(define weight (/ percentage 100.0))
152
Added:
(for/fold ([acc acc])
153
Added:
([(nutrient value) (in-hash (crop-requirement-nutrient-values crop-requirement))])
154
Added:
(define contribution (* value weight))
155
Added:
(hash-update acc nutrient (λ (old) (+ old contribution)) (λ () contribution)))))
models/fertilizer-product.rkt
@@ -6,17 +6,17 @@
6
6
(rename-out [fertilizer-product-canonical-name fertilizer-name]
7
7
[fertilizer-product-nutrient-values fertilizer-product-values]
8
8
[fertilizer-product-brand-name fertilizer-brand-name])
9
Removed:
(contract-out
10
Removed:
[create-fertilizer-product!
11
Removed:
(->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)]
12
Removed:
[get-fertilizer-products (-> (listof fertilizer-product?))]
13
Removed:
[get-fertilizer-product
14
Removed:
(->* ()
15
Removed:
(#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
16
Removed:
(or/c fertilizer-product? #f))]
17
Removed:
[get-fertilizer-product-values (-> fertilizer-product? (listof nutrient-value-pair/c))]
18
Removed:
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
19
Removed:
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
9
Added:
(contract-out [create-fertilizer-product!
10
Added:
(->* (string? nutrient-value-hash/c) (string?) fertilizer-product?)]
11
Added:
[get-fertilizer-products (-> (listof fertilizer-product?))]
12
Added:
[get-fertilizer-product
13
Added:
(->* ()
14
Added:
(#:id (or/c #f exact-nonnegative-integer?)
15
Added:
#:canonical-name (or/c #f string?))
16
Added:
(or/c fertilizer-product? #f))]
17
Added:
[get-fertilizer-product-values (-> fertilizer-product? nutrient-value-hash/c)]
18
Added:
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
19
Added:
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
20
20
21
21
(require racket/contract
22
22
db
@@ -37,8 +37,7 @@
37
37
(fertilizer-product-canonical-name v)
38
38
(fertilizer-product-brand-name v))
39
39
(fprintf out "~a\n" (fertilizer-product-canonical-name v)))
40
Removed:
(for ([nv (in-list (fertilizer-product-nutrient-values v))])
41
Removed:
(match-define (cons n v) nv)
40
Added:
(for ([(n v) (in-hash (fertilizer-product-nutrient-values v))])
42
41
(fprintf out
43
42
"~a ~a\n"
44
43
(~a (nutrient-name n) #:min-width 14)
@@ -65,8 +64,7 @@
65
64
(define nvs-id
66
65
(query-value (current-conn)
67
66
(select id #:from nutrient_value_sets #:where (= fertilizer_product_id ,fp-id))))
68
Removed:
(for ([nv nutrient-values])
69
Removed:
(match-define (cons n v) nv)
67
Added:
(for ([(n v) (in-hash nutrient-values)])
70
68
(query-exec (current-conn)
71
69
(insert #:into nutrient_values
72
70
#:set [value_set_id ,nvs-id]
@@ -87,22 +85,22 @@
87
85
88
86
(define (grouped-row->fertilizer-product row)
89
87
(match-define (vector fp-id canonical-name brand-name residuals) row)
90
Removed:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
91
Removed:
(fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name))
88
Added:
(fertilizer-product fp-id canonical-name (residuals->nutrient-value-hash residuals) brand-name))
92
89
93
90
(define (get-fertilizer-products)
94
Removed:
(define grouped-rows (query-rows (current-conn)
95
Removed:
(select fp.id
96
Removed:
fp.canonical_name
97
Removed:
fp.brand_name
98
Removed:
n.id
99
Removed:
n.canonical_name
100
Removed:
n.formula
101
Removed:
nv.value_ppm
102
Removed:
#:from (TableExpr:AST ,joined)
103
Removed:
#:order-by fp.canonical_name
104
Removed:
#:asc)
105
Removed:
#:group '#(0 1 2)))
91
Added:
(define grouped-rows
92
Added:
(query-rows (current-conn)
93
Added:
(select fp.id
94
Added:
fp.canonical_name
95
Added:
fp.brand_name
96
Added:
n.id
97
Added:
n.canonical_name
98
Added:
n.formula
99
Added:
nv.value_ppm
100
Added:
#:from (TableExpr:AST ,joined)
101
Added:
#:order-by fp.canonical_name
102
Added:
#:asc)
103
Added:
#:group '#(0 1 2)))
106
104
(for/list ([row grouped-rows])
107
105
(grouped-row->fertilizer-product row)))
108
106
@@ -134,7 +132,7 @@
134
132
[many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
135
133
136
134
(define (get-fertilizer-product-values fertilizer-product)
137
Removed:
(for/list ([(nutrient-id name formula value_ppm)
135
Added:
(for/hash ([(nutrient-id name formula value_ppm)
138
136
(in-query (current-conn)
139
137
(select n.id
140
138
n.canonical_name
@@ -142,7 +140,7 @@
142
140
nv.value_ppm
143
141
#:from (TableExpr:AST ,joined)
144
142
#:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
145
Removed:
(cons (nutrient nutrient-id name formula) value_ppm)))
143
Added:
(values (nutrient nutrient-id name formula) value_ppm)))
146
144
147
145
(define (get-fertilizer-product-value fertilizer-product nutrient)
148
146
(query-maybe-value (current-conn)
models/nutrient-measurement.rkt
@@ -6,14 +6,13 @@
6
6
(rename-out [nutrient-measurement-measured-on nutrient-measurement-date]
7
7
[nutrient-measurement-nutrient-values nutrient-measurement-values])
8
8
(contract-out
9
Removed:
[create-nutrient-measurement!
10
Removed:
(-> string? (listof nutrient-value-pair/c) nutrient-measurement?)]
9
Added:
[create-nutrient-measurement! (-> string? nutrient-value-hash/c nutrient-measurement?)]
11
10
[get-nutrient-measurements (-> (listof nutrient-measurement?))]
12
11
[get-nutrient-measurement
13
12
(->* ()
14
13
(#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?))
15
14
(or/c nutrient-measurement? #f))]
16
Removed:
[get-nutrient-measurement-values (-> nutrient-measurement? (listof nutrient-value-pair/c))]
15
Added:
[get-nutrient-measurement-values (-> nutrient-measurement? nutrient-value-hash/c)]
17
16
[get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)]
18
17
[get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))]
19
18
[get-latest-nutrient-measurement-hash (-> (hash/c nutrient? number?))]
@@ -33,8 +32,7 @@
33
32
"Measurement #~a on ~a\n"
34
33
(nutrient-measurement-id v)
35
34
(nutrient-measurement-measured-on v))
36
Removed:
(for ([nv (nutrient-measurement-nutrient-values v)])
37
Removed:
(match-define (cons n v) nv)
35
Added:
(for ([(n v) (in-hash (nutrient-measurement-nutrient-values v))])
38
36
(fprintf out
39
37
"~a ~a\n"
40
38
(~a (nutrient-name n) #:min-width 14)
@@ -55,8 +53,7 @@
55
53
(define nvs-id
56
54
(query-value (current-conn)
57
55
(select id #:from nutrient_value_sets #:where (= nutrient_measurement_id ,nm-id))))
58
Removed:
(for ([nv nutrient-values])
59
Removed:
(match-define (cons n v) nv)
56
Added:
(for ([(n v) (in-hash nutrient-values)])
60
57
(query-exec (current-conn)
61
58
(insert #:into nutrient_values
62
59
#:set [value_set_id ,nvs-id]
@@ -77,21 +74,21 @@
77
74
78
75
(define (grouped-row->nutrient-measurement row)
79
76
(match-define (vector nm-id measured-on residuals) row)
80
Removed:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
81
Removed:
(nutrient-measurement nm-id measured-on nutrient-value-pairs))
77
Added:
(nutrient-measurement nm-id measured-on (residuals->nutrient-value-hash residuals)))
82
78
83
79
(define (get-nutrient-measurements)
84
Removed:
(define grouped-rows (query-rows (current-conn)
85
Removed:
(select nm.id
86
Removed:
nm.measured_on
87
Removed:
n.id
88
Removed:
n.canonical_name
89
Removed:
n.formula
90
Removed:
nv.value_ppm
91
Removed:
#:from (TableExpr:AST ,joined)
92
Removed:
#:order-by nm.measured_on
93
Removed:
#:desc)
94
Removed:
#:group '#(0 1)))
80
Added:
(define grouped-rows
81
Added:
(query-rows (current-conn)
82
Added:
(select nm.id
83
Added:
nm.measured_on
84
Added:
n.id
85
Added:
n.canonical_name
86
Added:
n.formula
87
Added:
nv.value_ppm
88
Added:
#:from (TableExpr:AST ,joined)
89
Added:
#:order-by nm.measured_on
90
Added:
#:desc)
91
Added:
#:group '#(0 1)))
95
92
(for/list ([row grouped-rows])
96
93
(grouped-row->nutrient-measurement row)))
97
94
@@ -122,7 +119,7 @@
122
119
[many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
123
120
124
121
(define (get-nutrient-measurement-values nutrient-measurement)
125
Removed:
(for/list ([(nutrient-id name formula value_ppm)
122
Added:
(for/hash ([(nutrient-id name formula value_ppm)
126
123
(in-query (current-conn)
127
124
(select n.id
128
125
n.canonical_name
@@ -130,7 +127,7 @@
130
127
nv.value_ppm
131
128
#:from (TableExpr:AST ,joined)
132
129
#:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
133
Removed:
(cons (nutrient nutrient-id name formula) value_ppm)))
130
Added:
(values (nutrient nutrient-id name formula) value_ppm)))
134
131
135
132
(define (get-nutrient-measurement-value nutrient-measurement nutrient)
136
133
(query-maybe-value (current-conn)
@@ -149,17 +146,16 @@
149
146
#:limit 1)))
150
147
151
148
(define (get-latest-nutrient-measurement-hash)
152
Removed:
(for/hash ([(n-id n-name n-formula residual-rows)
153
Removed:
(in-query (current-conn)
154
Removed:
(select n.id
155
Removed:
n.canonical_name
156
Removed:
n.formula
157
Removed:
nm.measured_on
158
Removed:
nv.value_ppm
159
Removed:
#:from (TableExpr:AST ,joined)
160
Removed:
#:order-by nm.measured_on
161
Removed:
#:desc)
162
Removed:
#:group '(#(0 1 2)))])
149
Added:
(for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
150
Added:
(select n.id
151
Added:
n.canonical_name
152
Added:
n.formula
153
Added:
nm.measured_on
154
Added:
nv.value_ppm
155
Added:
#:from (TableExpr:AST ,joined)
156
Added:
#:order-by nm.measured_on
157
Added:
#:desc)
158
Added:
#:group '(#(0 1 2)))])
163
159
;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm)
164
160
(match-define (vector _measured-on value-ppm) (first residual-rows))
165
161
(values (nutrient n-id n-name n-formula) value-ppm)))
models/nutrient-target.rkt
@@ -5,18 +5,18 @@
5
5
nutrient-target-id
6
6
(rename-out [nutrient-target-effective-on nutrient-target-date]
7
7
[nutrient-target-nutrient-values nutrient-target-values])
8
Removed:
(contract-out
9
Removed:
[create-nutrient-target! (-> string? (listof nutrient-value-pair/c) nutrient-target?)]
10
Removed:
[get-nutrient-targets (-> (listof nutrient-target?))]
11
Removed:
[get-nutrient-target
12
Removed:
(->* ()
13
Removed:
(#:id (or/c #f exact-nonnegative-integer?) #:effective-on (or/c #f string?))
14
Removed:
(or/c nutrient-target? #f))]
15
Removed:
[get-nutrient-target-values (-> nutrient-target? (listof nutrient-value-pair/c))]
16
Removed:
[get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
17
Removed:
[get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
18
Removed:
[get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))]
19
Removed:
[delete-nutrient-target! (-> nutrient-target? void?)]))
8
Added:
(contract-out [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
9
Added:
[get-nutrient-targets (-> (listof nutrient-target?))]
10
Added:
[get-nutrient-target
11
Added:
(->* ()
12
Added:
(#:id (or/c #f exact-nonnegative-integer?)
13
Added:
#:effective-on (or/c #f string?))
14
Added:
(or/c nutrient-target? #f))]
15
Added:
[get-nutrient-target-values (-> nutrient-target? nutrient-value-hash/c)]
16
Added:
[get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
17
Added:
[get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
18
Added:
[get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))]
19
Added:
[delete-nutrient-target! (-> nutrient-target? void?)]))
20
20
21
21
(require racket/contract
22
22
db
@@ -29,8 +29,7 @@
29
29
#:property prop:custom-write
30
30
(λ (v out _)
31
31
(fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-effective-on v))
32
Removed:
(for ([nv (nutrient-target-nutrient-values v)])
33
Removed:
(match-define (cons n v) nv)
32
Added:
(for ([(n v) (in-hash (nutrient-target-nutrient-values v))])
34
33
(fprintf out
35
34
"~a ~a\n"
36
35
(~a (nutrient-name n) #:min-width 14)
@@ -50,8 +49,7 @@
50
49
(define nvs-id
51
50
(query-value (current-conn)
52
51
(select id #:from nutrient_value_sets #:where (= nutrient_target_id ,nt-id))))
53
Removed:
(for ([nv nutrient-values])
54
Removed:
(match-define (cons n v) nv)
52
Added:
(for ([(n v) (in-hash nutrient-values)])
55
53
(query-exec (current-conn)
56
54
(insert #:into nutrient_values
57
55
#:set [value_set_id ,nvs-id]
@@ -72,8 +70,7 @@
72
70
73
71
(define (grouped-row->nutrient-target row)
74
72
(match-define (vector nt-id effective-on residuals) row)
75
Removed:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
76
Removed:
(nutrient-target nt-id effective-on nutrient-value-pairs))
73
Added:
(nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals)))
77
74
78
75
(define (get-nutrient-targets)
79
76
(for/list ([grouped-row (in-query (current-conn)
@@ -116,7 +113,7 @@
116
113
[many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
117
114
118
115
(define (get-nutrient-target-values nutrient-target)
119
Removed:
(for/list ([(nutrient-id name formula value_ppm)
116
Added:
(for/hash ([(nutrient-id name formula value_ppm)
120
117
(in-query (current-conn)
121
118
(select n.id
122
119
n.canonical_name
@@ -124,7 +121,7 @@
124
121
nv.value_ppm
125
122
#:from (TableExpr:AST ,joined)
126
123
#:where (= nt.id ,(nutrient-target-id nutrient-target))))])
127
Removed:
(cons (nutrient nutrient-id name formula) value_ppm)))
124
Added:
(values (nutrient nutrient-id name formula) value_ppm)))
128
125
129
126
(define (get-nutrient-target-value nutrient-target nutrient)
130
127
(query-maybe-value (current-conn)
@@ -143,17 +140,16 @@
143
140
#:limit 1)))
144
141
145
142
(define (get-latest-nutrient-target-hash)
146
Removed:
(for/hash ([(n-id n-name n-formula residual-rows)
147
Removed:
(in-query (current-conn)
148
Removed:
(select n.id
149
Removed:
n.canonical_name
150
Removed:
n.formula
151
Removed:
nt.effective_on
152
Removed:
nv.value_ppm
153
Removed:
#:from (TableExpr:AST ,joined)
154
Removed:
#:order-by nt.effective_on
155
Removed:
#:desc)
156
Removed:
#:group '(#(0 1 2)))])
143
Added:
(for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
144
Added:
(select n.id
145
Added:
n.canonical_name
146
Added:
n.formula
147
Added:
nt.effective_on
148
Added:
nv.value_ppm
149
Added:
#:from (TableExpr:AST ,joined)
150
Added:
#:order-by nt.effective_on
151
Added:
#:desc)
152
Added:
#:group '(#(0 1 2)))])
157
153
;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm)
158
154
(match-define (vector _effective-on value-ppm) (first residual-rows))
159
155
(values (nutrient n-id n-name n-formula) value-ppm)))
models/nutrient.rkt
@@ -5,7 +5,7 @@
5
5
nutrient-id
6
6
nutrient-name
7
7
nutrient-formula
8
Removed:
nutrient-value-pair/c
8
Added:
nutrient-value-hash/c
9
9
(contract-out [create-nutrient! (-> string? string? nutrient?)]
10
10
[get-nutrients (-> (listof nutrient?))]
11
11
[get-nutrient
@@ -18,7 +18,9 @@
18
18
(->* (nutrient?)
19
19
(#:name (or/c #f string?) #:formula (or/c #f string?))
20
20
(or/c nutrient? #f))]
21
Removed:
[delete-nutrient! (-> nutrient? void?)]))
21
Added:
[delete-nutrient! (-> nutrient? void?)]
22
Added:
[residuals->nutrient-value-hash
23
Added:
(-> (listof residual-vector/c) nutrient-value-hash/c)]))
22
24
23
25
(require racket/contract
24
26
db
@@ -30,7 +32,15 @@
30
32
#:property prop:custom-write
31
33
(λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
32
34
33
Removed:
(define nutrient-value-pair/c (cons/c nutrient? (and/c real? (>=/c 0))))
35
Added:
(define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t))
36
Added:
37
Added:
;; vector/c id, nutrient name, nutrient formula, value (ppm)
38
Added:
(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?))
39
Added:
40
Added:
(define (residuals->nutrient-value-hash residuals)
41
Added:
(for/hash ([r (in-list residuals)])
42
Added:
(match-define (vector n-id n-name n-formula value-ppm) r)
43
Added:
(values (nutrient n-id n-name n-formula) value-ppm)))
34
44
35
45
;; CREATE
36
46
services/nnls.rkt
@@ -176,10 +176,7 @@
176
176
(λ (i j)
177
177
(define selected-nutrient (list-ref nutrients i))
178
178
(define product (list-ref fertilizers j))
179
Removed:
(define pair (assoc selected-nutrient (fertilizer-product-values product)))
180
Removed:
(if pair
181
Removed:
(cdr pair)
182
Removed:
0))))
179
Added:
(hash-ref (fertilizer-product-values product) selected-nutrient 0))))
183
180
184
181
(module+ test
185
182
(require rackunit
tests/models/nutrient-measurement.rkt
@@ -24,7 +24,7 @@
24
24
(test-case "Create measurement with date and values"
25
25
(define nitrogen (get-nutrient #:name "Nitrogen"))
26
26
(define phosphorus (get-nutrient #:name "Phosphorus"))
27
Removed:
(create-nutrient-measurement! measurement-date `((,nitrogen . 12.3) (,phosphorus . 4.5)))
27
Added:
(create-nutrient-measurement! measurement-date (hash nitrogen 12.3 phosphorus 4.5))
28
28
(check-equal? (length (get-nutrient-measurements)) 1)
29
29
(define nm (get-nutrient-measurement #:measured-on measurement-date))
30
30
(check-true (nutrient-measurement? nm))
@@ -43,15 +43,15 @@
43
43
(get-nutrient-measurement-values nm)
44
44
nmv
45
45
"return value of get-nutrient-measurement-values ≠ nutrient-measurement-values struct accessor")
46
Removed:
(check-equal? (length nmv) 2)
47
Removed:
(check-equal? (cdr (assoc nitrogen nmv)) 12.3)
48
Removed:
(check-equal? (cdr (assoc phosphorus nmv)) 4.5))
46
Added:
(check-equal? (hash-count nmv) 2)
47
Added:
(check-equal? (hash-ref nmv nitrogen) 12.3)
48
Added:
(check-equal? (hash-ref nmv phosphorus) 4.5))
49
49
50
50
(test-case "Retrieve latest measurement values"
51
51
(define nitrogen (get-nutrient #:name "Nitrogen"))
52
52
(define phosphorus (get-nutrient #:name "Phosphorus"))
53
53
(define second-measurement-date "2025-09-02")
54
Removed:
(create-nutrient-measurement! second-measurement-date `((,nitrogen . 6.7) (,phosphorus . 8.9)))
54
Added:
(create-nutrient-measurement! second-measurement-date (hash nitrogen 6.7 phosphorus 8.9))
55
55
56
56
(check-equal? (get-latest-nutrient-measurement-value nitrogen) 6.7)
57
57
(check-equal? (get-latest-nutrient-measurement-value phosphorus) 8.9))
@@ -63,4 +63,4 @@
63
63
(check-equal? (length (get-nutrient-measurements))
64
64
1
65
65
"wrong number of nutrient measurements were deleted")
66
Removed:
(check-true (null? (get-nutrient-measurement-values nm)))))))
66
Added:
(check-true (hash-empty? (get-nutrient-measurement-values nm)))))))