[Racket] Ferti hydroponic nutrient solver, redux.
Use db library grouping mechanism rather than ad-hoc accumulator.
Changed files
models/crop-requirement.rkt
@@ -60,73 +60,82 @@
60
60
61
61
;; READ
62
62
63
Added:
(define joined
64
Added:
(table-expr-qq (inner-join (inner-join (inner-join (as crop_requirements cr)
65
Added:
(as nutrient_value_sets nvs)
66
Added:
#:on (= nvs.crop_requirement_id cr.id))
67
Added:
(as nutrient_values nv)
68
Added:
#:on (= nv.value_set_id nvs.id))
69
Added:
(as nutrients n)
70
Added:
#:on (= n.id nv.nutrient_id))))
71
Added:
72
Added:
(define (grouped-row->crop-requirement row)
73
Added:
(match-define (vector cr-id profile crop-id residuals) row)
74
Added:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
75
Added:
(crop-requirement cr-id profile crop-id nutrient-value-pairs))
76
Added:
63
77
(define (get-crop-requirements)
64
Removed:
(for/list ([(id* profile* crop-id*)
65
Removed:
(in-query (current-conn)
66
Removed:
(select id profile crop_id
67
Removed:
#:from crop_requirements
68
Removed:
#:order-by id #:asc))])
69
Removed:
(crop-requirement id* profile* (if (sql-null? crop-id*) #f crop-id*))))
78
Added:
(define grouped-rows
79
Added:
(query-rows (current-conn)
80
Added:
(select cr.id
81
Added:
cr.profile
82
Added:
cr.crop_id
83
Added:
n.id
84
Added:
n.canonical_name
85
Added:
n.formula
86
Added:
nv.value_ppm
87
Added:
#:from (TableExpr:AST ,joined)
88
Added:
#:order-by cr.id
89
Added:
#:asc)
90
Added:
#:group '#(0 1 2)))
91
Added:
(for/list ([row grouped-rows])
92
Added:
(grouped-row->crop-requirement row)))
70
93
71
Removed:
(define (get-crop-requirement #:id [id #f]
72
Removed:
#:profile [profile #f]
73
Removed:
#:crop [crop #f])
74
Removed:
(define (where-expr)
75
Removed:
(define clauses
76
Removed:
(filter values
77
Removed:
(list
78
Removed:
(and id (format "id = ~e" id))
79
Removed:
(and profile (format "profile = ~e" profile))
80
Removed:
(and crop (format "crop_id = ~e" (crop-id crop))))))
94
Added:
(define (get-crop-requirement #:id [cr-id #f] #:profile [profile #f] #:crop-id [crop-id #f])
95
Added:
(define where
81
96
(cond
82
Removed:
[(null? clauses) ""]
83
Removed:
[else (format "WHERE ~a" (string-join clauses " AND "))]))
84
Removed:
(define query (string-join
85
Removed:
`("SELECT id, profile, crop_id"
86
Removed:
"FROM crop_requirements"
87
Removed:
,(where-expr)
88
Removed:
"ORDER BY id ASC"
89
Removed:
"LIMIT 1")))
90
Removed:
(match (query-maybe-row (current-conn) query)
91
Removed:
[(vector id* profile* crop-id*)
92
Removed:
(crop-requirement id* profile* crop-id*)]
93
Removed:
[#f #f]))
97
Added:
[(and cr-id profile crop-id)
98
Added:
(scalar-expr-qq (and (= cr.id ,cr-id) (= cr.profile ,profile) (= cr.crop_id ,crop-id)))]
99
Added:
[cr-id (scalar-expr-qq (= cr.id ,cr-id))]
100
Added:
[profile (scalar-expr-qq (= cr.profile ,profile))]
101
Added:
[crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))]
102
Added:
[else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")]))
94
103
104
Added:
(define grouped-rows
105
Added:
(query-rows (current-conn)
106
Added:
(select cr.id
107
Added:
cr.profile
108
Added:
cr.crop_id
109
Added:
n.id
110
Added:
n.canonical_name
111
Added:
n.formula
112
Added:
nv.value_ppm
113
Added:
#:from (TableExpr:AST ,joined)
114
Added:
#:where (ScalarExpr:AST ,where))
115
Added:
#:group '#(0 1 2)))
116
Added:
117
Added:
(match grouped-rows
118
Added:
['() #f]
119
Added:
[(list row) (grouped-row->crop-requirement row)]
120
Added:
[many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
121
Added:
95
122
(define (get-crop-requirement-values crop-requirement)
96
123
(for/list ([(nutrient-id name formula value_ppm)
97
124
(in-query (current-conn)
98
Removed:
(string-join '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
99
Removed:
"FROM nutrient_values nv"
100
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
101
Removed:
"JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
102
Removed:
"JOIN nutrients n ON n.id = nv.nutrient_id"
103
Removed:
"WHERE cr.id = $1"))
104
Removed:
(crop-requirement-id crop-requirement))])
125
Added:
(select n.id
126
Added:
n.canonical_name
127
Added:
n.formula
128
Added:
nv.value_ppm
129
Added:
#:from (TableExpr:AST ,joined)
130
Added:
#:where (= cr.id ,(crop-requirement-id crop-requirement))))])
105
131
(cons (nutrient nutrient-id name formula) value_ppm)))
106
132
107
133
(define (get-crop-requirement-value crop-requirement nutrient)
108
134
(query-maybe-value (current-conn)
109
Removed:
(string-join
110
Removed:
'("SELECT value_ppm"
111
Removed:
"FROM nutrient_values nv"
112
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
113
Removed:
"JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
114
Removed:
"WHERE cr.id = $1 AND nv.nutrient_id = $2"))
115
Removed:
(crop-requirement-id crop-requirement)
116
Removed:
(nutrient-id nutrient)))
117
Removed:
118
Removed:
(define (get-latest-crop-requirement-value nutrient)
119
Removed:
(query-maybe-value (current-conn)
120
Removed:
(string-join
121
Removed:
'("SELECT value_ppm"
122
Removed:
"FROM nutrient_values nv"
123
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
124
Removed:
"JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
125
Removed:
"WHERE nv.nutrient_id = $1"
126
Removed:
"ORDER BY cr.profile DESC"
127
Removed:
"LIMIT 1"))
128
Removed:
(nutrient-id nutrient)))
129
Removed:
135
Added:
(select value_ppm
136
Added:
#:from (TableExpr:AST ,joined)
137
Added:
#:where (and (= cr.id ,(crop-requirement-id crop-requirement))
138
Added:
(= nv.nutrient_id ,(nutrient-id nutrient))))))
130
139
131
140
;; UPDATE
132
141
models/fertilizer-product.rkt
@@ -76,8 +76,6 @@
76
76
77
77
;; READ
78
78
79
Removed:
(struct acc (canonical-name brand-name pairs) #:transparent)
80
Removed:
81
79
(define joined
82
80
(table-expr-qq (inner-join (inner-join (inner-join (as fertilizer_products fp)
83
81
(as nutrient_value_sets nvs)
@@ -87,32 +85,26 @@
87
85
(as nutrients n)
88
86
#:on (= n.id nv.nutrient_id))))
89
87
88
Added:
(define (grouped-row->fertilizer-product row)
89
Added:
(match-define (vector fp-id canonical-name brand-name residuals) row)
90
Added:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
91
Added:
(fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name))
92
Added:
90
93
(define (get-fertilizer-products)
91
Removed:
(define query
92
Removed:
(select fp.id
93
Removed:
fp.canonical_name
94
Removed:
fp.brand_name
95
Removed:
n.id
96
Removed:
n.canonical_name
97
Removed:
n.formula
98
Removed:
nv.value_ppm
99
Removed:
#:from (TableExpr:AST ,joined)
100
Removed:
#:order-by fp.canonical_name
101
Removed:
#:asc))
102
Removed:
(define rows (query-rows (current-conn) query))
103
Removed:
(define by-id
104
Removed:
(for/fold ([h (hash)]) ([row (in-list rows)])
105
Removed:
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
106
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
107
Removed:
(hash-update h
108
Removed:
fp-id
109
Removed:
(λ (old-acc)
110
Removed:
(acc (acc-canonical-name old-acc)
111
Removed:
(acc-brand-name old-acc)
112
Removed:
(cons nv-pair (acc-pairs old-acc))))
113
Removed:
(λ () (acc canonical-name brand-name (list nv-pair))))))
114
Removed:
(for/list ([(id a) (in-hash by-id)])
115
Removed:
(fertilizer-product id (acc-canonical-name a) (reverse (acc-pairs a)) (acc-brand-name a))))
94
Added:
(define grouped-rows (query-rows (current-conn)
95
Added:
(select fp.id
96
Added:
fp.canonical_name
97
Added:
fp.brand_name
98
Added:
n.id
99
Added:
n.canonical_name
100
Added:
n.formula
101
Added:
nv.value_ppm
102
Added:
#:from (TableExpr:AST ,joined)
103
Added:
#:order-by fp.canonical_name
104
Added:
#:asc)
105
Added:
#:group '#(0 1 2)))
106
Added:
(for/list ([row grouped-rows])
107
Added:
(grouped-row->fertilizer-product row)))
116
108
117
109
(define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f])
118
110
(define where
@@ -120,35 +112,26 @@
120
112
[(and fp-id canonical-name)
121
113
(scalar-expr-qq (and (= fp.id ,fp-id) (= fp.canonical_name ,canonical-name)))]
122
114
[fp-id (scalar-expr-qq (= fp.id ,fp-id))]
123
Removed:
[canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
124
Removed:
(define query
125
Removed:
(select fp.id
126
Removed:
fp.canonical_name
127
Removed:
fp.brand_name
128
Removed:
n.id
129
Removed:
n.canonical_name
130
Removed:
n.formula
131
Removed:
nv.value_ppm
132
Removed:
#:from (TableExpr:AST ,joined)
133
Removed:
#:where (ScalarExpr:AST ,where)
134
Removed:
#:limit 1))
135
Removed:
(define rows (query-rows (current-conn) query))
136
Removed:
(cond
137
Removed:
[(null? rows) #f]
138
Removed:
[else
139
Removed:
;; Fold all nutrient value rows belonging to the single fertilizer product into one struct
140
Removed:
(define the-id #f)
141
Removed:
(define A #f)
142
Removed:
(for ([row (in-list rows)])
143
Removed:
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
144
Removed:
(unless the-id
145
Removed:
(set! the-id fp-id))
146
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
147
Removed:
(set! A
148
Removed:
(if A
149
Removed:
(acc (acc-canonical-name A) (acc-brand-name A) (cons nv-pair (acc-pairs A)))
150
Removed:
(acc canonical-name brand-name (list nv-pair)))))
151
Removed:
(fertilizer-product the-id (acc-canonical-name A) (reverse (acc-pairs A)) (acc-brand-name A))]))
115
Added:
[canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))]
116
Added:
[else (error 'get-fertilizer-product "either #:id or #:canonical-name must be provided")]))
117
Added:
(define grouped-rows
118
Added:
(query-rows (current-conn)
119
Added:
(select fp.id
120
Added:
fp.canonical_name
121
Added:
fp.brand_name
122
Added:
n.id
123
Added:
n.canonical_name
124
Added:
n.formula
125
Added:
nv.value_ppm
126
Added:
#:from (TableExpr:AST ,joined)
127
Added:
#:where (ScalarExpr:AST ,where)
128
Added:
#:order-by fp.canonical_name
129
Added:
#:asc)
130
Added:
#:group '#(0 1 2)))
131
Added:
(match grouped-rows
132
Added:
['() #f]
133
Added:
[(list row) (grouped-row->fertilizer-product row)]
134
Added:
[many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
152
135
153
136
(define (get-fertilizer-product-values fertilizer-product)
154
137
(for/list ([(nutrient-id name formula value_ppm)
models/nutrient-measurement.rkt
@@ -66,7 +66,6 @@
66
66
67
67
;; READ
68
68
69
Removed:
(struct acc (measured-on pairs) #:transparent)
70
69
(define joined
71
70
(table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm)
72
71
(as nutrient_value_sets nvs)
@@ -76,66 +75,51 @@
76
75
(as nutrients n)
77
76
#:on (= n.id nv.nutrient_id))))
78
77
78
Added:
(define (grouped-row->nutrient-measurement row)
79
Added:
(match-define (vector nm-id measured-on residuals) row)
80
Added:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
81
Added:
(nutrient-measurement nm-id measured-on nutrient-value-pairs))
79
82
80
83
(define (get-nutrient-measurements)
81
Removed:
(define query (select nm.id nm.measured_on
82
Removed:
n.id n.canonical_name n.formula
83
Removed:
nv.value_ppm
84
Removed:
#:from (TableExpr:AST ,joined)
85
Removed:
#:order-by nm.measured_on #:desc))
86
Removed:
(define rows (query-rows (current-conn) query))
87
Removed:
(define by-id
88
Removed:
(for/fold ([h (hash)]) ([row (in-list rows)])
89
Removed:
(match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
90
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
91
Removed:
(hash-update h nm-id
92
Removed:
(λ (old-acc)
93
Removed:
(acc (acc-measured-on old-acc)
94
Removed:
(cons nv-pair (acc-pairs old-acc))))
95
Removed:
(λ ()
96
Removed:
(acc measured-on
97
Removed:
(list nv-pair))))))
98
Removed:
(for/list ([(id a) (in-hash by-id)])
99
Removed:
(nutrient-measurement id
100
Removed:
(acc-measured-on a)
101
Removed:
(reverse (acc-pairs a)))))
84
Added:
(define grouped-rows (query-rows (current-conn)
85
Added:
(select nm.id
86
Added:
nm.measured_on
87
Added:
n.id
88
Added:
n.canonical_name
89
Added:
n.formula
90
Added:
nv.value_ppm
91
Added:
#:from (TableExpr:AST ,joined)
92
Added:
#:order-by nm.measured_on
93
Added:
#:desc)
94
Added:
#:group '#(0 1)))
95
Added:
(for/list ([row grouped-rows])
96
Added:
(grouped-row->nutrient-measurement row)))
102
97
103
Removed:
(define (get-nutrient-measurement #:id [nm-id #f]
104
Removed:
#:measured-on [measured-on #f])
98
Added:
(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f])
105
99
(define where
106
100
(cond
107
101
[(and nm-id measured-on)
108
Removed:
(scalar-expr-qq (and (= nm.id ,nm-id)
109
Removed:
(= nm.measured_on ,measured-on)))]
110
Removed:
[nm-id
111
Removed:
(scalar-expr-qq (= nm.id ,nm-id))]
112
Removed:
[measured-on
113
Removed:
(scalar-expr-qq (= nm.measured_on ,measured-on))]))
114
Removed:
(define query (select nm.id nm.measured_on
115
Removed:
n.id n.canonical_name n.formula
102
Added:
(scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))]
103
Added:
[nm-id (scalar-expr-qq (= nm.id ,nm-id))]
104
Added:
[measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))]
105
Added:
[else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")]))
106
Added:
(define grouped-rows
107
Added:
(query-rows (current-conn)
108
Added:
(select nm.id
109
Added:
nm.measured_on
110
Added:
n.id
111
Added:
n.canonical_name
112
Added:
n.formula
116
113
nv.value_ppm
117
114
#:from (TableExpr:AST ,joined)
118
Removed:
#:where (ScalarExpr:AST ,where)))
119
Removed:
(define rows (query-rows (current-conn) query))
120
Removed:
(cond
121
Removed:
[(null? rows) #f]
122
Removed:
[else
123
Removed:
;; Fold all nutrient value rows belonging to the single nutrient measurement into one struct
124
Removed:
(define the-id #f)
125
Removed:
(define A #f)
126
Removed:
(for ([row (in-list rows)])
127
Removed:
(match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
128
Removed:
(unless the-id (set! the-id nm-id))
129
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
130
Removed:
(set! A (if A
131
Removed:
(acc (acc-measured-on A)
132
Removed:
(cons nv-pair (acc-pairs A)))
133
Removed:
(acc measured-on
134
Removed:
(list nv-pair)))))
135
Removed:
(and A
136
Removed:
(nutrient-measurement the-id
137
Removed:
(acc-measured-on A)
138
Removed:
(reverse (acc-pairs A))))]))
115
Added:
#:where (ScalarExpr:AST ,where)
116
Added:
#:order-by nm.measured_on
117
Added:
#:desc)
118
Added:
#:group '#(0 1)))
119
Added:
(match grouped-rows
120
Added:
['() #f]
121
Added:
[(list row) (grouped-row->nutrient-measurement row)]
122
Added:
[many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
139
123
140
124
(define (get-nutrient-measurement-values nutrient-measurement)
141
125
(for/list ([(nutrient-id name formula value_ppm)
models/nutrient-target.rkt
@@ -61,8 +61,6 @@
61
61
62
62
;; READ
63
63
64
Removed:
(struct acc (effective-on pairs) #:transparent)
65
Removed:
66
64
(define joined
67
65
(table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt)
68
66
(as nutrient_value_sets nvs)
@@ -72,28 +70,24 @@
72
70
(as nutrients n)
73
71
#:on (= n.id nv.nutrient_id))))
74
72
73
Added:
(define (grouped-row->nutrient-target row)
74
Added:
(match-define (vector nt-id effective-on residuals) row)
75
Added:
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
76
Added:
(nutrient-target nt-id effective-on nutrient-value-pairs))
77
Added:
75
78
(define (get-nutrient-targets)
76
Removed:
(define query
77
Removed:
(select nt.id
78
Removed:
nt.effective_on
79
Removed:
n.id
80
Removed:
n.canonical_name
81
Removed:
n.formula
82
Removed:
nv.value_ppm
83
Removed:
#:from (TableExpr:AST ,joined)
84
Removed:
#:order-by nt.effective_on
85
Removed:
#:desc))
86
Removed:
(define rows (query-rows (current-conn) query))
87
Removed:
(define by-id
88
Removed:
(for/fold ([h (hash)]) ([row (in-list rows)])
89
Removed:
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
90
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
91
Removed:
(hash-update h
92
Removed:
nt-id
93
Removed:
(λ (old-acc) (acc (acc-effective-on old-acc) (cons nv-pair (acc-pairs old-acc))))
94
Removed:
(λ () (acc effective-on (list nv-pair))))))
95
Removed:
(for/list ([(id a) (in-hash by-id)])
96
Removed:
(nutrient-target id (acc-effective-on a) (reverse (acc-pairs a)))))
79
Added:
(for/list ([grouped-row (in-query (current-conn)
80
Added:
(select nt.id
81
Added:
nt.effective_on
82
Added:
n.id
83
Added:
n.canonical_name
84
Added:
n.formula
85
Added:
nv.value_ppm
86
Added:
#:from (TableExpr:AST ,joined)
87
Added:
#:order-by nt.effective_on
88
Added:
#:desc)
89
Added:
#:group '#(0 1))])
90
Added:
(grouped-row->nutrient-target grouped-row)))
97
91
98
92
(define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f])
99
93
(define where
@@ -101,33 +95,25 @@
101
95
[(and nt-id effective-on)
102
96
(scalar-expr-qq (and (= nt.id ,nt-id) (= nt.effective_on ,effective-on)))]
103
97
[nt-id (scalar-expr-qq (= nt.id ,nt-id))]
104
Removed:
[effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))]))
105
Removed:
(define query
106
Removed:
(select nt.id
107
Removed:
nt.effective_on
108
Removed:
n.id
109
Removed:
n.canonical_name
110
Removed:
n.formula
111
Removed:
nv.value_ppm
112
Removed:
#:from (TableExpr:AST ,joined)
113
Removed:
#:where (ScalarExpr:AST ,where)))
114
Removed:
(define rows (query-rows (current-conn) query))
115
Removed:
(cond
116
Removed:
[(null? rows) #f]
117
Removed:
[else
118
Removed:
;; Fold all nutrient rows belonging to the single target into one struct
119
Removed:
(define the-id #f)
120
Removed:
(define A #f)
121
Removed:
(for ([row (in-list rows)])
122
Removed:
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
123
Removed:
(unless the-id
124
Removed:
(set! the-id nt-id))
125
Removed:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
126
Removed:
(set! A
127
Removed:
(if A
128
Removed:
(acc (acc-effective-on A) (cons nv-pair (acc-pairs A)))
129
Removed:
(acc effective-on (list nv-pair)))))
130
Removed:
(and A (nutrient-target the-id (acc-effective-on A) (reverse (acc-pairs A))))]))
98
Added:
[effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))]
99
Added:
[else (error 'get-nutrient-target "either #:id or #:effective-on must be provided")]))
100
Added:
(define grouped-rows
101
Added:
(query-rows (current-conn)
102
Added:
(select nt.id
103
Added:
nt.effective_on
104
Added:
n.id
105
Added:
n.canonical_name
106
Added:
n.formula
107
Added:
nv.value_ppm
108
Added:
#:from (TableExpr:AST ,joined)
109
Added:
#:where (ScalarExpr:AST ,where)
110
Added:
#:order-by nt.effective_on
111
Added:
#:desc)
112
Added:
#:group '#(0 1)))
113
Added:
(match grouped-rows
114
Added:
['() #f]
115
Added:
[(list row) (grouped-row->nutrient-target row)]
116
Added:
[many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
131
117
132
118
(define (get-nutrient-target-values nutrient-target)
133
119
(for/list ([(nutrient-id name formula value_ppm)