[Racket] Ferti hydroponic nutrient solver, redux.

Add French name to nutrient model.

Commit
b4b113796455b85389df1c826f6e7ec93e804001
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
db/migrations.rkt
index 48e788f3..d07b130f 100644..100644
@@ -49,6 +49,7 @@
49 49 (list (create-table #:if-not-exists nutrients
50 50 #:columns [id integer #:not-null]
51 51 [canonical_name text #:not-null]
52 Added: [french_name text #:not-null]
52 53 [formula text #:not-null]
53 54 #:constraints (primary-key id)
54 55 (unique canonical_name)
db/seed.rkt
index 9693e891..75306513 100644..100644
@@ -23,28 +23,27 @@
23 23 seed-existing-fertilizer-products!))
24 24
25 25 (define (seed-nutrients!)
26 Removed: (define nutrient-names (map nutrient-name (get-nutrients)))
26 Added: (define nutrient-names (map nutrient-canonical-name (get-nutrients)))
27 27 (define default-nutrients
28 Removed: '(("Nitrate Nitrogen" . "NNO3") ("Phosphorus" . "P")
29 Removed: ("Potassium" . "K")
30 Removed: ("Calcium" . "Ca")
31 Removed: ("Magnesium" . "Mg")
32 Removed: ("Sulfur" . "S")
33 Removed: ("Sodium" . "Na")
34 Removed: ("Chloride" . "Cl")
35 Removed: ("Silicon" . "Si")
36 Removed: ("Iron" . "Fe")
37 Removed: ("Zinc" . "Zn")
38 Removed: ("Boron" . "B")
39 Removed: ("Manganese" . "Mn")
40 Removed: ("Copper" . "Cu")
41 Removed: ("Molybdenum" . "Mo")
42 Removed: ("Ammonium Nitrogen" . "NNH4")))
43 Removed: (with-tx (for ([pair (in-list default-nutrients)])
44 Removed: (match-define (cons name formula) pair)
45 Removed: ;; Ensure idempotence
46 Removed: (unless (member name nutrient-names)
47 Removed: (create-nutrient! name formula)))))
28 Added: '(("Nitrate Nitrogen" "Azote nitrique" "NNO3") ("Phosphorus" "Phosphore" "P")
29 Added: ("Potassium" "Potassium" "K")
30 Added: ("Calcium" "Calcium" "Ca")
31 Added: ("Magnesium" "Magnésium" "Mg")
32 Added: ("Sulfur" "Soufre" "S")
33 Added: ("Sodium" "Sodium" "Na")
34 Added: ("Chloride" "Chlore" "Cl")
35 Added: ("Silicon" "Silicium" "Si")
36 Added: ("Iron" "Fer" "Fe")
37 Added: ("Zinc" "Zinc" "Zn")
38 Added: ("Boron" "Bore" "B")
39 Added: ("Manganese" "Manganèse" "Mn")
40 Added: ("Copper" "Cuivre" "Cu")
41 Added: ("Molybdenum" "Molybdène" "Mo")
42 Added: ("Ammonium Nitrogen" "Azote ammoniacal" "NNH4")))
43 Added: (with-tx (for ([nutrient-data (in-list default-nutrients)])
44 Added: (match-define (list canonical-name french-name formula) nutrient-data)
45 Added: (unless (member canonical-name nutrient-names)
46 Added: (create-nutrient! canonical-name french-name formula)))))
48 47
49 48 (define-runtime-path measurement-csv "data/dolibarr_nutrient_measurements_ppm.csv")
50 49 (define (seed-historical-nutrient-measurements!)
formlets.rkt
index d96f3742..ce92129a 100644..100644
@@ -22,11 +22,11 @@
22 22 (input #:type "number"
23 23 #:attributes `((class "form-control") [id ,(number->string id)]
24 24 [step "0.1"]
25 Removed: [placeholder ,(nutrient-name nutrient)])))
25 Added: [placeholder ,(nutrient-french-name nutrient)])))
26 26 (define input-label
27 27 `(label ((for ,(number->string id)
28 28 ))
29 Removed: ,(nutrient-name nutrient)))
29 Added: ,(nutrient-french-name nutrient)))
30 30 (formlet (#%# (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value-b} ,input-label))
31 31 (let ([nutrient-value (string->number (bytes->string/utf-8
32 32 (binding:form-value nutrient-value-b)))])
models/crop-requirement.rkt
index fb147772..c0eb7536 100644..100644
@@ -80,6 +80,7 @@
80 80 cr.crop_id
81 81 n.id
82 82 n.canonical_name
83 Added: n.french_name
83 84 n.formula
84 85 nv.value_ppm
85 86 #:from (TableExpr:AST ,joined)
@@ -98,7 +99,6 @@
98 99 [profile (scalar-expr-qq (= cr.profile ,profile))]
99 100 [crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))]
100 101 [else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")]))
101 Removed:
102 102 (define grouped-rows
103 103 (query-rows (current-conn)
104 104 (select cr.id
@@ -106,27 +106,28 @@
106 106 cr.crop_id
107 107 n.id
108 108 n.canonical_name
109 Added: n.french_name
109 110 n.formula
110 111 nv.value_ppm
111 112 #:from (TableExpr:AST ,joined)
112 113 #:where (ScalarExpr:AST ,where))
113 114 #:group '#(0 1 2)))
114 Removed:
115 115 (match grouped-rows
116 116 ['() #f]
117 117 [(list row) (grouped-row->crop-requirement row)]
118 118 [many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
119 119
120 120 (define (get-crop-requirement-values crop-requirement)
121 Removed: (for/hash ([(nutrient-id name formula value_ppm)
121 Added: (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
122 122 (in-query (current-conn)
123 123 (select n.id
124 124 n.canonical_name
125 Added: n.french_name
125 126 n.formula
126 127 nv.value_ppm
127 128 #:from (TableExpr:AST ,joined)
128 129 #:where (= cr.id ,(crop-requirement-id crop-requirement))))])
129 Removed: (values (nutrient nutrient-id name formula) value_ppm)))
130 Added: (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
130 131
131 132 (define (get-crop-requirement-value crop-requirement nutrient)
132 133 (query-maybe-value (current-conn)
models/fertilizer-product.rkt
index 347d141b..b0ac7de6 100644..100644
@@ -39,7 +39,7 @@
39 39 (for ([(n v) (in-hash (fertilizer-product-nutrient-values v))])
40 40 (fprintf out
41 41 "~a ~a\n"
42 Removed: (~a (nutrient-name n) #:min-width 14)
42 Added: (~a (nutrient-canonical-name n) #:min-width 14)
43 43 (~a v #:max-width 6 #:align 'right)))))
44 44
45 45 ;; CREATE
@@ -91,6 +91,7 @@
91 91 fp.brand_name
92 92 n.id
93 93 n.canonical_name
94 Added: n.french_name
94 95 n.formula
95 96 nv.value_ppm
96 97 #:from (TableExpr:AST ,joined)
@@ -115,6 +116,7 @@
115 116 fp.brand_name
116 117 n.id
117 118 n.canonical_name
119 Added: n.french_name
118 120 n.formula
119 121 nv.value_ppm
120 122 #:from (TableExpr:AST ,joined)
@@ -128,15 +130,16 @@
128 130 [many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
129 131
130 132 (define (get-fertilizer-product-values fertilizer-product)
131 Removed: (for/hash ([(nutrient-id name formula value_ppm)
133 Added: (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
132 134 (in-query (current-conn)
133 135 (select n.id
134 136 n.canonical_name
137 Added: n.french_name
135 138 n.formula
136 139 nv.value_ppm
137 140 #:from (TableExpr:AST ,joined)
138 141 #:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
139 Removed: (values (nutrient nutrient-id name formula) value_ppm)))
142 Added: (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
140 143
141 144 (define (get-fertilizer-product-value fertilizer-product nutrient)
142 145 (query-maybe-value (current-conn)
models/nutrient-measurement.rkt
index 3e8213df..5b5f93d2 100644..100644
@@ -35,7 +35,7 @@
35 35 (for ([(n v) (in-hash (nutrient-measurement-nutrient-values v))])
36 36 (fprintf out
37 37 "~a ~a\n"
38 Removed: (~a (nutrient-name n) #:min-width 14)
38 Added: (~a (nutrient-canonical-name n) #:min-width 14)
39 39 (~a v #:max-width 6 #:align 'right)))))
40 40
41 41 ;; CREATE
@@ -83,6 +83,7 @@
83 83 nm.measured_on
84 84 n.id
85 85 n.canonical_name
86 Added: n.french_name
86 87 n.formula
87 88 nv.value_ppm
88 89 #:from (TableExpr:AST ,joined)
@@ -106,6 +107,7 @@
106 107 nm.measured_on
107 108 n.id
108 109 n.canonical_name
110 Added: n.french_name
109 111 n.formula
110 112 nv.value_ppm
111 113 #:from (TableExpr:AST ,joined)
@@ -119,15 +121,16 @@
119 121 [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
120 122
121 123 (define (get-nutrient-measurement-values nutrient-measurement)
122 Removed: (for/hash ([(nutrient-id name formula value_ppm)
124 Added: (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
123 125 (in-query (current-conn)
124 126 (select n.id
125 127 n.canonical_name
128 Added: n.french_name
126 129 n.formula
127 130 nv.value_ppm
128 131 #:from (TableExpr:AST ,joined)
129 132 #:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
130 Removed: (values (nutrient nutrient-id name formula) value_ppm)))
133 Added: (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
131 134
132 135 (define (get-nutrient-measurement-value nutrient-measurement nutrient)
133 136 (query-maybe-value (current-conn)
@@ -146,19 +149,23 @@
146 149 #:limit 1)))
147 150
148 151 (define (get-latest-nutrient-measurement-hash)
149 Removed: (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
150 Removed: (select n.id
151 Removed: n.canonical_name
152 Removed: n.formula
153 Removed: nm.measured_on
154 Removed: nv.value_ppm
155 Removed: #:from (TableExpr:AST ,joined)
156 Removed: #:order-by nm.measured_on
157 Removed: #:desc)
158 Removed: #:group '(#(0 1 2)))])
152 Added: (define grouped-rows
153 Added: (query-rows (current-conn)
154 Added: (select n.id
155 Added: n.canonical_name
156 Added: n.french_name
157 Added: n.formula
158 Added: nm.measured_on
159 Added: nv.value_ppm
160 Added: #:from (TableExpr:AST ,joined)
161 Added: #:order-by nm.measured_on
162 Added: #:desc)
163 Added: #:group '(#(0 1 2 3))))
164 Added: (for/hash ([row grouped-rows])
165 Added: (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row)
159 166 ;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm)
160 167 (match-define (vector _measured-on value-ppm) (first residual-rows))
161 Removed: (values (nutrient n-id n-name n-formula) value-ppm)))
168 Added: (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
162 169
163 170 ;; UPDATE
164 171
models/nutrient-target.rkt
index ce4d561b..cffa6571 100644..100644
@@ -32,7 +32,7 @@
32 32 (for ([(n v) (in-hash (nutrient-target-nutrient-values v))])
33 33 (fprintf out
34 34 "~a ~a\n"
35 Removed: (~a (nutrient-name n) #:min-width 14)
35 Added: (~a (nutrient-canonical-name n) #:min-width 14)
36 36 (~a v #:max-width 6 #:align 'right)))))
37 37
38 38 ;; CREATE
@@ -78,6 +78,7 @@
78 78 nt.effective_on
79 79 n.id
80 80 n.canonical_name
81 Added: n.french_name
81 82 n.formula
82 83 nv.value_ppm
83 84 #:from (TableExpr:AST ,joined)
@@ -100,6 +101,7 @@
100 101 nt.effective_on
101 102 n.id
102 103 n.canonical_name
104 Added: n.french_name
103 105 n.formula
104 106 nv.value_ppm
105 107 #:from (TableExpr:AST ,joined)
@@ -113,15 +115,16 @@
113 115 [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
114 116
115 117 (define (get-nutrient-target-values nutrient-target)
116 Removed: (for/hash ([(nutrient-id name formula value_ppm)
118 Added: (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
117 119 (in-query (current-conn)
118 120 (select n.id
119 121 n.canonical_name
122 Added: n.french_name
120 123 n.formula
121 124 nv.value_ppm
122 125 #:from (TableExpr:AST ,joined)
123 126 #:where (= nt.id ,(nutrient-target-id nutrient-target))))])
124 Removed: (values (nutrient nutrient-id name formula) value_ppm)))
127 Added: (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
125 128
126 129 (define (get-nutrient-target-value nutrient-target nutrient)
127 130 (query-maybe-value (current-conn)
@@ -140,19 +143,23 @@
140 143 #:limit 1)))
141 144
142 145 (define (get-latest-nutrient-target-hash)
143 Removed: (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
144 Removed: (select n.id
145 Removed: n.canonical_name
146 Removed: n.formula
147 Removed: nt.effective_on
148 Removed: nv.value_ppm
149 Removed: #:from (TableExpr:AST ,joined)
150 Removed: #:order-by nt.effective_on
151 Removed: #:desc)
152 Removed: #:group '(#(0 1 2)))])
146 Added: (define grouped-rows
147 Added: (query-rows (current-conn)
148 Added: (select n.id
149 Added: n.canonical_name
150 Added: n.french_name
151 Added: n.formula
152 Added: nt.effective_on
153 Added: nv.value_ppm
154 Added: #:from (TableExpr:AST ,joined)
155 Added: #:order-by nt.effective_on
156 Added: #:desc)
157 Added: #:group '(#(0 1 2 3))))
158 Added: (for/hash ([row grouped-rows])
159 Added: (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row)
153 160 ;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm)
154 161 (match-define (vector _effective-on value-ppm) (first residual-rows))
155 Removed: (values (nutrient n-id n-name n-formula) value-ppm)))
162 Added: (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
156 163
157 164 ;; UPDATE
158 165
models/nutrient.rkt
index 3e2767b1..fd78cc81 100644..100644
@@ -3,10 +3,11 @@
3 3 (provide nutrient
4 4 nutrient?
5 5 nutrient-id
6 Removed: nutrient-name
6 Added: nutrient-canonical-name
7 Added: nutrient-french-name
7 8 nutrient-formula
8 9 nutrient-value-hash/c
9 Removed: (contract-out [create-nutrient! (-> string? string? nutrient?)]
10 Added: (contract-out [create-nutrient! (-> string? string? string? nutrient?)]
10 11 [get-nutrients (-> (listof nutrient?))]
11 12 [get-nutrient
12 13 (->* ()
@@ -27,54 +28,66 @@
27 28 sql
28 29 "../db/conn.rkt")
29 30
30 Removed: (struct nutrient (id name formula)
31 Added: (struct nutrient (id canonical-name french-name formula)
31 32 #:transparent
32 33 #:property prop:custom-write
33 Removed: (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
34 Added: (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v))))
34 35
35 36 (define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t))
36 37
37 Removed: ;; vector/c id, nutrient name, nutrient formula, value (ppm)
38 Removed: (define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?))
38 Added: ;; vector/c id, canonical name, french name, nutrient formula, value (ppm)
39 Added: (define residual-vector/c (vector/c exact-nonnegative-integer? string? string? string? real?))
39 40
40 41 (define (residuals->nutrient-value-hash residuals)
41 42 (for/hash ([r (in-list residuals)])
42 Removed: (match-define (vector n-id n-name n-formula value-ppm) r)
43 Removed: (values (nutrient n-id n-name n-formula) value-ppm)))
43 Added: (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r)
44 Added: (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
44 45
45 46 ;; CREATE
46 47
47 Removed: (define (create-nutrient! name formula)
48 Removed: (or (get-nutrient #:name name #:formula formula)
48 Added: (define (create-nutrient! canonical-name french-name formula)
49 Added: (or (get-nutrient #:name canonical-name #:formula formula)
49 50 (begin
50 51 (query-exec (current-conn)
51 Removed: (insert #:into nutrients #:set [canonical_name ,name] [formula ,formula]))
52 Removed: (get-nutrient #:name name))))
52 Added: (insert #:into nutrients
53 Added: #:set [canonical_name ,canonical-name]
54 Added: [french_name ,french-name]
55 Added: [formula ,formula]))
56 Added: (get-nutrient #:name canonical-name))))
53 57
54 58 ;; READ
55 59
60 Added: (define (row->nutrient row)
61 Added: (match-define (vector id canonical-name french-name formula) row)
62 Added: (nutrient id canonical-name french-name formula))
63 Added:
56 64 (define (get-nutrients)
57 Removed: (for/list ([(id name formula)
58 Removed: (in-query (current-conn)
59 Removed: (select id canonical_name formula #:from nutrients #:order-by id #:asc))])
60 Removed: (nutrient id name formula)))
65 Added: (define rows
66 Added: (query-rows (current-conn)
67 Added: (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc)))
68 Added: (map row->nutrient rows))
61 69
62 Removed: (define (get-nutrient #:id [id #f] #:name [name #f] #:formula [formula #f])
63 Removed: (define (where-expr)
64 Removed: (define clauses
65 Removed: (filter values
66 Removed: (list (and id (format "id = ~e" id))
67 Removed: (and name (format "canonical_name = ~e" name))
68 Removed: (and formula (format "formula = ~e" formula)))))
70 Added: (define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f])
71 Added: (define where
69 72 (cond
70 Removed: [(null? clauses) ""]
71 Removed: [else (format "WHERE ~a" (string-join clauses " AND "))]))
73 Added: [(and id canonical-name formula)
74 Added: (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))]
75 Added: [id (scalar-expr-qq (= id ,id))]
76 Added: [(and canonical-name formula)
77 Added: (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))]
78 Added: [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))]
79 Added: [formula (scalar-expr-qq (= formula ,formula))]))
72 80 (match (query-maybe-row (current-conn)
73 Removed: (string-join `("SELECT id, canonical_name, formula" "FROM nutrients"
74 Removed: ,(where-expr)
75 Removed: "ORDER BY id ASC"
76 Removed: "LIMIT 1")))
77 Removed: [(vector id* name* formula*) (nutrient id* name* formula*)]
81 Added: (select id
82 Added: canonical_name
83 Added: french_name
84 Added: formula
85 Added: #:from nutrients
86 Added: #:where (ScalarExpr:AST ,where)
87 Added: #:order-by id
88 Added: #:asc
89 Added: #:limit 1))
90 Added: [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)]
78 91 [#f #f]))
79 92
80 93 ;; UPDATE
tests/models/nutrient.rkt
index 1e4fa8ff..525ef66a 100644..100644
@@ -14,9 +14,10 @@
14 14 #:after (λ () (disconnect!))
15 15
16 16 (test-case "Create nutrients"
17 Removed: (create-nutrient! "Examplium" "Ex")
17 Added: (check-equal? (length (get-nutrients)) 0)
18 Added: (create-nutrient! "Examplium" "" "Ex")
18 19 (check-equal? (length (get-nutrients)) 1)
19 Removed: (create-nutrient! "Ignorium" "Ig")
20 Added: (create-nutrient! "Ignorium" "" "Ig")
20 21 (check-equal? (length (get-nutrients)) 2))
21 22
22 23 (test-case "Read nutrient"
@@ -27,7 +28,7 @@
27 28 (test-case "Read nutrient by name"
28 29 (define examplium (get-nutrient #:name "Examplium"))
29 30 (check-true (nutrient? examplium))
30 Removed: (check-equal? (nutrient-name examplium) "Examplium"))
31 Added: (check-equal? (nutrient-canonical-name examplium) "Examplium"))
31 32
32 33 (test-case "Read nutrient by formula"
33 34 (define examplium (get-nutrient #:formula "Ex"))
@@ -41,14 +42,14 @@
41 42 (define examplium (get-nutrient #:name "Examplium"))
42 43 (define examplium-nitrate (update-nutrient! examplium #:name "Examplium Nitrate"))
43 44 (check-equal? (length (get-nutrients)) 2)
44 Removed: (check-equal? (nutrient-name examplium-nitrate) "Examplium Nitrate")
45 Added: (check-equal? (nutrient-canonical-name examplium-nitrate) "Examplium Nitrate")
45 46 (check-equal? (nutrient-formula examplium-nitrate) "Ex"))
46 47
47 48 (test-case "Update nutrient formula"
48 49 (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
49 50 (define examplium-sulfate (update-nutrient! examplium-nitrate #:formula "ExSO4"))
50 51 (check-equal? (length (get-nutrients)) 2)
51 Removed: (check-equal? (nutrient-name examplium-sulfate) "Examplium Nitrate")
52 Added: (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Nitrate")
52 53 (check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))
53 54
54 55 (test-case "Update nutrient name and formula"
@@ -56,7 +57,7 @@
56 57 (define examplium-sulfate
57 58 (update-nutrient! examplium-nitrate #:name "Examplium Sulfate" #:formula "ExNO3"))
58 59 (check-equal? (length (get-nutrients)) 2)
59 Removed: (check-equal? (nutrient-name examplium-sulfate) "Examplium Sulfate")
60 Added: (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Sulfate")
60 61 (check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))
61 62
62 63 (test-case "Delete nutrient"