[Racket] Ferti hydroponic nutrient solver, redux.
Update nutrient target with out beautiful new logic.
models/nutrient-target.rkt
@@ -4,7 +4,10 @@
4
4
;; Struct definitions
5
5
nutrient-target
6
6
nutrient-target?
7
Removed:
nutrient-target-id nutrient-target-effective-on
7
Added:
nutrient-target-id
8
Added:
(rename-out
9
Added:
[nutrient-target-effective-on nutrient-target-date]
10
Added:
[nutrient-target-nutrient-values nutrient-target-values])
8
11
;; SQL CRUD
9
12
(contract-out
10
13
[create-nutrient-target! (-> string?
@@ -17,7 +20,8 @@
17
20
(or/c nutrient-target? #f))]
18
21
[get-nutrient-target-values (-> nutrient-target? (listof (cons/c nutrient? number?)))]
19
22
[get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
20
Removed:
[get-latest-nutrient-target-value (-> nutrient? number?)]
23
Added:
;; Before the first target is createed, the "latest" value is basically false.
24
Added:
[get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
21
25
[delete-nutrient-target! (-> nutrient-target? void?)]))
22
26
23
27
(require racket/contract
@@ -27,71 +31,115 @@
27
31
"nutrient.rkt")
28
32
29
33
;; Instances of this struct are persisted in the nutrient_targets table.
30
Removed:
(struct nutrient-target (id effective-on) #:transparent)
34
Added:
(struct nutrient-target (id effective-on nutrient-values) #:transparent)
31
35
32
36
33
37
;; CREATE
34
38
35
39
(define (create-nutrient-target! effective-on nutrient-values)
36
Removed:
(define existing-nutrient-target (get-nutrient-target #:effective-on effective-on))
37
Removed:
(define (new-nutrient-target)
38
Removed:
(with-tx
39
Removed:
(query-exec (current-conn)
40
Removed:
(insert #:into nutrient_targets
41
Removed:
#:set [effective_on ,effective-on]))
42
Removed:
(define nm-id (nutrient-target-id (get-nutrient-target #:effective-on effective-on)))
43
Removed:
(query-exec (current-conn)
44
Removed:
(insert #:into nutrient_value_sets
45
Removed:
#:set [nutrient_target_id ,nm-id]))
46
Removed:
(define nvs-id (query-value (current-conn)
47
Removed:
(select id
48
Removed:
#:from nutrient_value_sets
49
Removed:
#:where (= nutrient_target_id ,nm-id))))
50
Removed:
(for ([nv nutrient-values])
51
Removed:
(match nv
52
Removed:
[(cons n v)
53
Removed:
(query-exec (current-conn)
54
Removed:
(insert #:into nutrient_values
55
Removed:
#:set
56
Removed:
[value_set_id ,nvs-id]
57
Removed:
[nutrient_id ,(nutrient-id n)]
58
Removed:
[value_ppm ,v]))])))
59
Removed:
(get-nutrient-target #:effective-on effective-on))
60
Removed:
(or existing-nutrient-target
61
Removed:
(new-nutrient-target)))
40
Added:
(or (get-nutrient-target #:effective-on effective-on)
41
Added:
(with-tx
42
Added:
(query-exec (current-conn)
43
Added:
(insert #:into nutrient_targets
44
Added:
#:set [effective_on ,effective-on]))
45
Added:
(define nt-id (query-value (current-conn)
46
Added:
(select id
47
Added:
#:from nutrient_targets
48
Added:
#:where (= effective_on ,effective-on))))
49
Added:
(query-exec (current-conn)
50
Added:
(insert #:into nutrient_value_sets
51
Added:
#:set [nutrient_target_id ,nt-id]))
52
Added:
(define nvs-id (query-value (current-conn)
53
Added:
(select id
54
Added:
#:from nutrient_value_sets
55
Added:
#:where (= nutrient_target_id ,nt-id))))
56
Added:
(for ([nv nutrient-values])
57
Added:
(match nv
58
Added:
[(cons n v)
59
Added:
(query-exec (current-conn)
60
Added:
(insert #:into nutrient_values
61
Added:
#:set
62
Added:
[value_set_id ,nvs-id]
63
Added:
[nutrient_id ,(nutrient-id n)]
64
Added:
[value_ppm ,v]))]))
65
Added:
(get-nutrient-target #:effective-on effective-on))))
62
66
63
67
64
68
;; READ
65
69
70
Added:
(struct acc (effective-on pairs) #:transparent)
71
Added:
72
Added:
(define joined
73
Added:
(table-expr-qq
74
Added:
(inner-join
75
Added:
(inner-join
76
Added:
(inner-join
77
Added:
(as nutrient_targets nt)
78
Added:
(as nutrient_value_sets nvs)
79
Added:
#:on (= nvs.nutrient_measurement_id nt.id))
80
Added:
(as nutrient_values nv)
81
Added:
#:on (= nv.value_set_id nvs.id))
82
Added:
(as nutrients n)
83
Added:
#:on (= n.id nv.nutrient_id))))
84
Added:
66
85
(define (get-nutrient-targets)
67
Removed:
(for/list ([(id* effective-on*)
68
Removed:
(in-query (current-conn)
69
Removed:
(select id effective_on
70
Removed:
#:from nutrient_targets
71
Removed:
#:order-by id ASC))])
72
Removed:
(nutrient-target id* effective-on*)))
86
Added:
(define query (select nt.id nt.effective_on
87
Added:
n.id n.canonical_name n.formula
88
Added:
nv.value_ppm
89
Added:
#:from (TableExpr:AST ,joined)
90
Added:
#:order-by nt.effective_on #:desc))
91
Added:
(define rows (query-rows (current-conn) query))
92
Added:
(define by-id
93
Added:
(for/fold ([h (hash)]) ([row (in-list rows)])
94
Added:
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
95
Added:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
96
Added:
(hash-update h nt-id
97
Added:
(λ (old-acc)
98
Added:
(acc (acc-effective-on old-acc)
99
Added:
(cons nv-pair (acc-pairs old-acc))))
100
Added:
(λ ()
101
Added:
(acc effective-on
102
Added:
(list nv-pair))))))
103
Added:
(for/list ([(id a) (in-hash by-id)])
104
Added:
(nutrient-target id
105
Added:
(acc-effective-on a)
106
Added:
(reverse (acc-pairs a)))))
73
107
74
Removed:
(define (get-nutrient-target #:id [id #f]
75
Removed:
#:effective-on [effective-on #f])
76
Removed:
(define (where-expr)
77
Removed:
(define clauses
78
Removed:
(filter values
79
Removed:
(list
80
Removed:
(and id (format "id = ~e" id))
81
Removed:
(and effective-on (format "effective_on = ~e" effective-on)))))
108
Added:
(define (get-nutrient-target #:id [nt-id #f]
109
Added:
#:effective-on [effective-on #f])
110
Added:
(define where
82
111
(cond
83
Removed:
[(null? clauses) ""]
84
Removed:
[else (format "WHERE ~a" (string-join clauses " AND "))]))
85
Removed:
(define query (string-join
86
Removed:
`("SELECT id, effective_on"
87
Removed:
"FROM nutrient_targets"
88
Removed:
,(where-expr)
89
Removed:
"ORDER BY id ASC"
90
Removed:
"LIMIT 1")))
91
Removed:
(match (query-maybe-row (current-conn) query)
92
Removed:
[(vector id* effective-on*)
93
Removed:
(nutrient-target id* effective-on*)]
94
Removed:
[#f #f]))
112
Added:
[(and nt-id effective-on)
113
Added:
(scalar-expr-qq (and (= nt.id ,nt-id)
114
Added:
(= nt.effective_on ,effective-on)))]
115
Added:
[nt-id
116
Added:
(scalar-expr-qq (= nt.id ,nt-id))]
117
Added:
[effective-on
118
Added:
(scalar-expr-qq (= nt.effective_on ,effective-on))]))
119
Added:
(define query (select nt.id nt.effective_on
120
Added:
n.id n.canonical_name n.formula
121
Added:
nv.value_ppm
122
Added:
#:from (TableExpr:AST ,joined)
123
Added:
#:where (ScalarExpr:AST ,where)))
124
Added:
(define rows (query-rows (current-conn) query))
125
Added:
(cond
126
Added:
[(null? rows) #f]
127
Added:
[else
128
Added:
;; Fold all nutrient rows belonging to the single target into one struct
129
Added:
(define the-id #f)
130
Added:
(define A #f)
131
Added:
(for ([row (in-list rows)])
132
Added:
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
133
Added:
(unless the-id (set! the-id nt-id))
134
Added:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
135
Added:
(set! A (if A
136
Added:
(acc (acc-effective-on A)
137
Added:
(cons nv-pair (acc-pairs A)))
138
Added:
(acc effective-on (list nv-pair)))))
139
Added:
(and A
140
Added:
(nutrient-target the-id
141
Added:
(acc-effective-on A)
142
Added:
(reverse (acc-pairs A))))]))
95
143
96
144
(define (get-nutrient-target-values nutrient-target)
97
145
(for/list ([(nutrient-id name formula value_ppm)