[Racket] Ferti hydroponic nutrient solver, redux.
Introduce crop rotations.
These will probably replace nutrient targets as the main entry point for nutrient requirement calculations.
db/migrations.rkt
@@ -143,6 +143,30 @@
143
143
#:constraints (primary-key id)
144
144
(foreign-key crop_id #:references (crops id) #:on-delete #:cascade))))
145
145
146
Added:
(define-migration "create table crop_rotations"
147
Added:
(list (create-table #:if-not-exists crop_rotations
148
Added:
#:columns [id integer #:not-null]
149
Added:
;; ISO8601 date
150
Added:
[rotation_date text #:not-null]
151
Added:
[nutrient_measurement_id integer]
152
Added:
#:constraints (primary-key id)
153
Added:
(foreign-key nutrient_measurement_id
154
Added:
#:references (nutrient_measurements id)
155
Added:
#:on-delete
156
Added:
#:set-null)
157
Added:
(unique rotation_date))))
158
Added:
159
Added:
(define-migration
160
Added:
"create table crop_rotation_requirements"
161
Added:
(list (create-table
162
Added:
#:if-not-exists crop_rotation_requirements
163
Added:
#:columns [crop_rotation_id integer #:not-null]
164
Added:
[crop_requirement_id integer #:not-null]
165
Added:
[proportion_percent integer #:not-null]
166
Added:
#:constraints (primary-key crop_rotation_id crop_requirement_id)
167
Added:
(foreign-key crop_rotation_id #:references (crop_rotation id) #:on-delete #:cascade)
168
Added:
(foreign-key crop_requirement_id #:references (crop_requirement id) #:on-delete #:cascade))))
169
Added:
146
170
;;;;;;;;;;;;;;
147
171
;; FERTILIZERS
148
172
;;;;;;;;;;;;;;
db/seed.rkt
@@ -9,6 +9,7 @@
9
9
"../models/nutrient-measurement.rkt"
10
10
"../models/crop.rkt"
11
11
"../models/crop-requirement.rkt"
12
Added:
"../models/crop-rotation.rkt"
12
13
"../models/fertilizer-product.rkt")
13
14
14
15
(define (seed-database!)
@@ -20,6 +21,7 @@
20
21
seed-historical-nutrient-measurements!
21
22
seed-crops!
22
23
seed-crop-requirements!
24
Added:
seed-initial-crop-rotation!
23
25
seed-existing-fertilizer-products!))
24
26
25
27
(define (seed-nutrients!)
@@ -89,6 +91,13 @@
89
91
(create-crop-requirement! profile nutrient-values crop)]
90
92
[else (create-crop-requirement! profile nutrient-values)]))
91
93
(with-tx (csv-for-each row->seed! next-row)))
94
Added:
95
Added:
(define (seed-initial-crop-rotation!)
96
Added:
(define nm (get-latest-nutrient-measurement))
97
Added:
(define generic-requirement (get-crop-requirement #:profile "générique croissance"))
98
Added:
(create-crop-rotation! (nutrient-measurement-date nm)
99
Added:
(hash generic-requirement 100)
100
Added:
#:nutrient-measurement (nutrient-measurement-id nm)))
92
101
93
102
(define-runtime-path fertilizer-products-csv "data/dolibarr_fertilizer_compositions_percentage.csv")
94
103
(define (seed-existing-fertilizer-products!)
handlers.rkt
@@ -13,6 +13,7 @@
13
13
"models/nutrient.rkt"
14
14
"models/nutrient-measurement.rkt"
15
15
"models/nutrient-target.rkt"
16
Added:
"models/crop-rotation.rkt"
16
17
"models/fertilizer-product.rkt"
17
18
"services/nnls.rkt")
18
19
@@ -47,31 +48,31 @@
47
48
void))
48
49
49
50
(define-values (fapg-dispatch fapg-url)
50
Removed:
(dispatch-rules [("index") #:method "get" index]
51
Removed:
;; Ferti
52
Removed:
[("ferti" "index") #:method "get" ferti-index]
53
Removed:
[("ferti" "measurements") #:method "get" ferti-measurements]
54
Removed:
[("ferti" "targets") #:method "get" ferti-targets]
55
Removed:
[("ferti" "recipe") #:method "get" ferti-recipe]
56
Removed:
[("ferti" "fertilizers") #:method "get" ferti-fertilizers]
57
Removed:
;; Nutrient measurements
58
Removed:
[("ferti" "measurement" "new") #:method "get" new-measurement]
59
Removed:
[("ferti" "measurement" "create") #:method "post" create-measurement]
60
Removed:
[("ferti" "measurement" (integer-arg)) #:method "get" show-measurement]
61
Removed:
[("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement]
62
Removed:
;; Nutrient targets
63
Removed:
[("ferti" "target" "new") #:method "get" new-target]
64
Removed:
[("ferti" "target" "create") #:method "post" create-target]
65
Removed:
[("ferti" "target" (integer-arg)) #:method "get" show-target]
66
Removed:
[("ferti" "target" (integer-arg)) #:method "delete" destroy-target]
67
Removed:
;; Fertilizer products
68
Removed:
[("ferti" "fertilizer" "new") #:method "get" new-fertilizer]
69
Removed:
[("ferti" "fertilizer" "create") #:method "post" create-fertilizer]
70
Removed:
[("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer]
71
Removed:
[("ferti" "fertilizer" "destroy" (integer-arg)) #:method "get" destroy-fertilizer]
72
Removed:
;; Default
73
Removed:
[("") #:method "get" index]
74
Removed:
[else fallback]))
51
Added:
(dispatch-rules
52
Added:
[("index") #:method "get" index]
53
Added:
;; Ferti
54
Added:
[("ferti" "index") #:method "get" ferti-index]
55
Added:
[("ferti" "measurements-and-rotations") #:method "get" ferti-measurements-and-rotations]
56
Added:
[("ferti" "recipe") #:method "get" ferti-recipe]
57
Added:
[("ferti" "fertilizers") #:method "get" ferti-fertilizers]
58
Added:
;; Nutrient measurements
59
Added:
[("ferti" "measurement" "new") #:method "get" new-measurement]
60
Added:
[("ferti" "measurement" "create") #:method "post" create-measurement]
61
Added:
[("ferti" "measurement" (integer-arg)) #:method "get" show-measurement]
62
Added:
[("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement]
63
Added:
;; Nutrient targets
64
Added:
[("ferti" "target" "new") #:method "get" new-target]
65
Added:
[("ferti" "target" "create") #:method "post" create-target]
66
Added:
[("ferti" "target" (integer-arg)) #:method "get" show-target]
67
Added:
[("ferti" "target" (integer-arg)) #:method "delete" destroy-target]
68
Added:
;; Fertilizer products
69
Added:
[("ferti" "fertilizer" "new") #:method "get" new-fertilizer]
70
Added:
[("ferti" "fertilizer" "create") #:method "post" create-fertilizer]
71
Added:
[("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer]
72
Added:
[("ferti" "fertilizer" "destroy" (integer-arg)) #:method "get" destroy-fertilizer]
73
Added:
;; Default
74
Added:
[("") #:method "get" index]
75
Added:
[else fallback]))
75
76
76
77
(define (render-page xexpr)
77
78
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
@@ -87,16 +88,12 @@
87
88
(define (ferti-index _)
88
89
(render-page (ferti-index-page)))
89
90
90
Removed:
(define (ferti-measurements _)
91
Added:
(define (ferti-measurements-and-rotations _)
91
92
(define nutrients (get-nutrients))
92
93
(define measurements (get-nutrient-measurements))
93
Removed:
(render-page (ferti-measurements-page nutrients measurements)))
94
Added:
(define rotations (get-crop-rotations))
95
Added:
(render-page (ferti-measurements-and-rotations-page nutrients measurements rotations)))
94
96
95
Removed:
(define (ferti-targets _)
96
Removed:
(define latest-measurement-hash (get-latest-nutrient-measurement-hash))
97
Removed:
(define latest-target-hash (get-latest-nutrient-target-hash))
98
Removed:
(render-page (ferti-targets-page latest-measurement-hash latest-target-hash)))
99
Removed:
100
97
(define (ferti-recipe _)
101
98
(define ferti-recipe (find-ferti-recipe))
102
99
(render-page (ferti-recipe-page ferti-recipe)))
@@ -113,7 +110,7 @@
113
110
(define (create-measurement req)
114
111
(define-values (measurement-date nutrient-values) (formlet-process (measurements-formlet) req))
115
112
(create-nutrient-measurement! measurement-date nutrient-values)
116
Removed:
(redirect-to "/ferti/measurements"))
113
Added:
(redirect-to "/ferti/measurements-and-rotations"))
117
114
118
115
(define (show-measurement _ id)
119
116
(define nm (get-nutrient-measurement #:id id))
models/crop-rotation.rkt
@@ -0,0 +1,138 @@
1
Added:
#lang racket
2
Added:
3
Added:
(provide crop-rotation
4
Added:
crop-rotation?
5
Added:
crop-rotation-id
6
Added:
(rename-out [crop-rotation-rotation-date crop-rotation-date]
7
Added:
[crop-rotation-requirement-proportions crop-rotation-requirements]
8
Added:
[crop-rotation-nutrient-measurement-id crop-rotation-measurement-id])
9
Added:
(contract-out [create-crop-rotation!
10
Added:
(->* (string? requirement-proportion-hash/c)
11
Added:
(#:nutrient-measurement exact-nonnegative-integer?)
12
Added:
crop-rotation?)]
13
Added:
[get-crop-rotations (-> (listof crop-rotation?))]
14
Added:
[get-crop-rotation
15
Added:
(->* () (#:id crop-rotation-id? #:date string?) (or/c crop-rotation? #f))]
16
Added:
[get-latest-crop-rotation (-> (or/c crop-rotation? #f))]
17
Added:
[delete-crop-rotation! (-> crop-rotation-or-id/c void?)]))
18
Added:
19
Added:
(require racket/contract
20
Added:
db
21
Added:
sql
22
Added:
"../db/conn.rkt"
23
Added:
"nutrient.rkt"
24
Added:
"crop-requirement.rkt")
25
Added:
26
Added:
(struct crop-rotation (id rotation-date requirement-proportions nutrient-measurement-id)
27
Added:
#:transparent
28
Added:
#:guard (λ (id rotation-date requirement-proportions nutrient-measurement-id _)
29
Added:
(values id
30
Added:
rotation-date
31
Added:
requirement-proportions
32
Added:
(if (sql-null? nutrient-measurement-id) #f nutrient-measurement-id))))
33
Added:
34
Added:
(define crop-rotation-id? exact-nonnegative-integer?)
35
Added:
(define crop-rotation-or-id/c (or/c crop-rotation? crop-rotation-id?))
36
Added:
(define requirement-proportion-hash/c (hash/c crop-requirement? (between/c 0 100) #:immutable #t))
37
Added:
38
Added:
(define (->cr-id cr-or-id)
39
Added:
(match cr-or-id
40
Added:
[(? crop-rotation-id? id) id]
41
Added:
[(crop-rotation id _ _ _) id]
42
Added:
[#f (error '->nt-id "#f can not be converted to an id")]))
43
Added:
44
Added:
;; CREATE
45
Added:
46
Added:
(define (create-crop-rotation! rotation-date
47
Added:
requirement-proportions
48
Added:
#:nutrient-measurement [nutrient-measurement-id #f])
49
Added:
(or (get-crop-rotation #:date rotation-date)
50
Added:
(with-tx
51
Added:
(if nutrient-measurement-id
52
Added:
(query-exec (current-conn)
53
Added:
(insert #:into crop_rotations
54
Added:
#:set [rotation_date ,rotation-date]
55
Added:
[nutrient_measurement_id ,nutrient-measurement-id]))
56
Added:
(query-exec (current-conn)
57
Added:
(insert #:into crop_rotations #:set [rotation_date ,rotation-date])))
58
Added:
(define cr-id
59
Added:
(query-value (current-conn)
60
Added:
(select id #:from crop_rotations #:where (= rotation_date ,rotation-date))))
61
Added:
(for ([(r p) (in-hash requirement-proportions)])
62
Added:
(query-exec (current-conn)
63
Added:
(insert #:into crop_rotation_requirements
64
Added:
#:set [crop_rotation_id ,cr-id]
65
Added:
[crop_requirement_id ,(crop-requirement-id r)]
66
Added:
[proportion_percent ,p])))
67
Added:
(get-crop-rotation #:date rotation-date))))
68
Added:
69
Added:
;; READ
70
Added:
71
Added:
(define joined
72
Added:
(table-expr-qq (inner-join (as crop_rotations cr)
73
Added:
(as crop_rotation_requirements crr)
74
Added:
#:on (= crr.crop_rotation_id cr.id))))
75
Added:
76
Added:
(define (residuals->requirement-proportion-hash residuals)
77
Added:
(for/hash ([r (in-list residuals)])
78
Added:
(match-define (vector requirement-id proportion) r)
79
Added:
(values requirement-id proportion)))
80
Added:
81
Added:
(define (grouped-row->crop-rotation grouped-row)
82
Added:
(match-define (vector cr-id cr-rotation-date cr-nutrient-measurement-id residuals) grouped-row)
83
Added:
(crop-rotation cr-id
84
Added:
cr-rotation-date
85
Added:
(residuals->requirement-proportion-hash residuals)
86
Added:
cr-nutrient-measurement-id))
87
Added:
88
Added:
(define (get-crop-rotations)
89
Added:
(define grouped-rows
90
Added:
(query-rows (current-conn)
91
Added:
(select cr.id
92
Added:
cr.rotation_date
93
Added:
cr.nutrient_measurement_id
94
Added:
crr.crop_requirement_id
95
Added:
crr.proportion_percent
96
Added:
#:from (TableExpr:AST ,joined)
97
Added:
#:order-by cr.rotation_date
98
Added:
#:desc)
99
Added:
#:group '#(0 1 2)))
100
Added:
(map grouped-row->crop-rotation grouped-rows))
101
Added:
102
Added:
(define (get-crop-rotation #:id [cr-id #f] #:date [rotation-date #f])
103
Added:
(define where
104
Added:
(cond
105
Added:
[(and cr-id rotation-date)
106
Added:
(scalar-expr-qq (and (= cr.id ,cr-id) (= cr.rotation_date ,rotation-date)))]
107
Added:
[cr-id (scalar-expr-qq (= cr.id ,cr-id))]
108
Added:
[rotation-date (scalar-expr-qq (= cr.rotation_date ,rotation-date))]
109
Added:
[else (error 'get-crop-rotation "either #:id or #:date must be provided")]))
110
Added:
(define grouped-rows
111
Added:
(query-rows (current-conn)
112
Added:
(select cr.id
113
Added:
cr.rotation_date
114
Added:
cr.nutrient_measurement_id
115
Added:
crr.crop_requirement_id
116
Added:
crr.proportion_percent
117
Added:
#:from (TableExpr:AST ,joined)
118
Added:
#:where (ScalarExpr:AST ,where)
119
Added:
#:order-by cr.rotation_date
120
Added:
#:desc)
121
Added:
#:group '#(0 1 2)))
122
Added:
(match grouped-rows
123
Added:
['() #f]
124
Added:
[(list grouped-row) (grouped-row->crop-rotation grouped-row)]
125
Added:
[many (error 'get-crop-rotation "expected 1 nutrient target, got ~a" (length many))]))
126
Added:
127
Added:
(define (get-latest-crop-rotation)
128
Added:
(define rotations (get-crop-rotations))
129
Added:
(if (null? rotations)
130
Added:
#f
131
Added:
(first rotations)))
132
Added:
133
Added:
;; UPDATE
134
Added:
135
Added:
;; DELETE
136
Added:
137
Added:
(define (delete-crop-rotation! cr-or-id)
138
Added:
(query-exec (current-conn) (delete #:from crop_rotations #:where (= id ,(->cr-id cr-or-id)))))
views.rkt
@@ -2,8 +2,7 @@
2
2
3
3
(provide index-page
4
4
ferti-index-page
5
Removed:
ferti-measurements-page
6
Removed:
ferti-targets-page
5
Added:
ferti-measurements-and-rotations-page
7
6
ferti-recipe-page
8
7
ferti-fertilizers-page
9
8
new-measurement-page
@@ -21,6 +20,7 @@
21
20
"models/nutrient.rkt"
22
21
"models/nutrient-measurement.rkt"
23
22
"models/nutrient-target.rkt"
23
Added:
"models/crop-rotation.rkt"
24
24
"models/fertilizer-product.rkt")
25
25
26
26
(define (page-template title body-xexpr)
@@ -83,13 +83,12 @@
83
83
(li ((class "nav-item"))
84
84
(a ((class "nav-link") (aria-current "page") (href "/ferti/index")) "Accueil"))
85
85
(li ((class "nav-item"))
86
Removed:
(a ((class "nav-link") (aria-current "page") (href "/ferti/measurements")) "Relevés"))
86
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/measurements-and-rotations"))
87
Added:
"Relevés & Cibles"))
87
88
(li ((class "nav-item"))
88
Removed:
(a ((class "nav-link") (aria-current "page") (href "/ferti/targets")) "Cibles"))
89
Removed:
(li ((class "nav-item"))
90
89
(a ((class "nav-link") (aria-current "page") (href "/ferti/fertilizers")) "Intrants"))
91
Removed:
(li ((class "nav-item"))
92
Removed:
(a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©"))))
90
Added:
#;(li ((class "nav-item"))
91
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©"))))
93
92
94
93
(define (ferti-index-page)
95
94
(ferti-template
@@ -100,19 +99,39 @@
100
99
(a ((class "btn btn-outline-primary") [href "/ferti/fertilizer/new"])
101
100
"Ajouter un intrant")))))
102
101
103
Removed:
(define (ferti-measurements-page nutrients measurements)
102
Added:
(define (ferti-measurements-and-rotations-page nutrients measurements rotations)
103
Added:
(define (maybe-rotation-for-measurement m)
104
Added:
(findf (λ (r) (= (crop-rotation-measurement-id r) (nutrient-measurement-id m))) rotations))
104
105
(define table
105
Removed:
`(table ((class "table"))
106
Removed:
(thead (tr (th "Date")))
107
Removed:
(tbody ,@(for/list ([m measurements])
108
Removed:
`(tr (td (a ((href ,(format "/ferti/measurement/~a"
109
Removed:
(nutrient-measurement-id m))))
110
Removed:
,(nutrient-measurement-date m))))))))
111
Removed:
(ferti-template `((h2 () "Relevés") (a ((class "btn btn-primary mb-3") [href
112
Removed:
"/ferti/measurement/new"])
113
Removed:
"Ajouter un relevé")
114
Removed:
,table)))
106
Added:
`(table
107
Added:
((class "table"))
108
Added:
(thead (tr (th "Date du relevé") (th "Relevé") (th "Cultures") (th "Recette")))
109
Added:
(tbody
110
Added:
,@(for/list ([m measurements])
111
Added:
(define maybe-rotation (maybe-rotation-for-measurement m))
112
Added:
`(tr (td ,(nutrient-measurement-date m))
113
Added:
(td (a ((class "btn btn-outline-secondary")
114
Added:
(href ,(format "/ferti/measurement/~a" (nutrient-measurement-id m))))
115
Added:
"Modifier"))
116
Added:
(td ,(if maybe-rotation
117
Added:
`(a ((class "btn btn-outline-secondary")
118
Added:
(href ,(format "/ferti/rotation/~a" (crop-rotation-id maybe-rotation))))
119
Added:
"Modifier")
120
Added:
`(a ((class "btn btn-outline-primary") (href "/ferti/rotation/new"))
121
Added:
"Ajouter")))
122
Added:
(td ,(if maybe-rotation
123
Added:
`(a ((class "btn btn-outline-secondary")
124
Added:
(href ,(format "/ferti/recipe/~a" (crop-rotation-date maybe-rotation))))
125
Added:
"Consulter")
126
Added:
"—")))))))
127
Added:
(ferti-template
128
Added:
`((h2 () "Relevés")
129
Added:
(div ((class "btn-group mb-3"))
130
Added:
(a ((class "btn btn-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé")
131
Added:
#;(a ((class "btn btn-secondary") [href "/ferti/target/new"]) "Créer une cible"))
132
Added:
,table)))
115
133
134
Added:
#;
116
135
(define (ferti-targets-page latest-measurement-hash latest-target-hash)
117
136
(define table
118
137
`(table ((class "table"))