1 #lang racket 2 3 (provide nutrient-value? 4 maybe-nutrient-value? 5 nutrient-value-hash/c 6 (contract-out [insert-nutrient-values 7 (-> connection? db-id? nutrient-value-hash/c (listof (cons/c symbol? any/c)))] 8 [get-sorted-nutrient-values 9 (-> nutrient-value-hash/c (listof (cons/c nutrient? nutrient-value?)))] 10 [update-nutrient-values! (-> connection? db-id? nutrient-value-hash/c void?)] 11 [residuals->nutrient-value-hash 12 (-> (listof residual-vector/c) nutrient-value-hash/c)])) 13 14 (require db 15 sql 16 racket/hash 17 "nutrient.rkt" 18 "utils.rkt") 19 20 (define nutrient-value? (and/c real? (>=/c 0))) 21 (define maybe-nutrient-value? (or/c nutrient-value? #f)) 22 (define nutrient-value-hash/c (hash/c nutrient? nutrient-value? #:immutable #t)) 23 24 ;; vector/c id, canonical name, french name, nutrient formula, value (ppm) 25 (define residual-vector/c (vector/c db-id? string? string? string? real?)) 26 27 (define (insert-nutrient-values conn nvs-id nutrient-values) 28 (define nv-rows 29 (for/list ([(n v) (in-hash nutrient-values)]) 30 (map value->scalar-expr-ast (list nvs-id (nutrient-id n) v)))) 31 (define result 32 (query conn 33 (insert #:into nutrient_values 34 #:columns value_set_id 35 nutrient_id 36 value_ppm 37 #:from (TableExpr:AST ,(make-values*-table-expr-ast nv-rows))))) 38 (simple-result-info result)) 39 40 (define (get-sorted-nutrient-values nv) 41 (sort (hash->list (hash-filter-values nv positive?)) > #:key cdr)) 42 43 (define (update-nutrient-values! conn nvs-id nutrient-values) 44 (for ([(n v) (in-hash nutrient-values)]) 45 (query-exec conn 46 (update nutrient_values 47 #:set [value_ppm ,v] 48 #:where (and (= value_set_id ,nvs-id) (= nutrient_id ,(nutrient-id n))))))) 49 50 (define (residuals->nutrient-value-hash residuals) 51 (for/hash ([r (in-list residuals)]) 52 (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r) 53 (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) 54 55 (module+ test 56 (require rackunit 57 rackunit/text-ui 58 db 59 sql 60 "../db/conn.rkt" 61 "../db/migrations.rkt" 62 "../models/nutrient.rkt") 63 64 (run-tests (test-suite "Nutrient value model" 65 #:before (λ () 66 (connect! #:path 'memory) 67 (migrate-all!) 68 (create-nutrient! "Examplium" "Examplium" "Ex") 69 (create-nutrient! "Ignorium" "Ignorium" "Ig") 70 (create-nutrient! "Testium" "Testium" "Ts") 71 (create-nutrient! "Zeroium" "Zeroium" "Zr")) 72 #:after (λ () (disconnect!)) 73 74 #;(test-case "Insert nutrient values" 75 (define ex (get-nutrient #:name "Examplium")) 76 (define ig (get-nutrient #:name "Ignorium")) 77 78 ;; Create a nutrient_value_set for testing 79 (define nvs-id 80 (insert-id (query (current-conn) 81 (insert #:into nutrient_value_sets 82 #:set [nutrient_measurement_id ,sql-null] 83 [crop_requirement_id ,sql-null] 84 [fertilizer_product_id ,sql-null])))) 85 86 (define nv-hash (hash ex 100.5 ig 50.25)) 87 (define result (insert-nutrient-values (current-conn) nvs-id nv-hash)) 88 89 (check-true (list? result)) 90 (check-true (assoc 'insert-id result)) 91 92 ;; Verify values were inserted 93 (define ex-value 94 (query-value (current-conn) 95 (select value_ppm 96 #:from nutrient_values 97 #:where (and (= value_set_id ,nvs-id) 98 (= nutrient_id ,(nutrient-id ex)))))) 99 (check-= ex-value 100.5 0.001)) 100 101 (test-case "Get sorted nutrient values filters positive and sorts descending" 102 (define ex (get-nutrient #:name "Examplium")) 103 (define ig (get-nutrient #:name "Ignorium")) 104 (define ts (get-nutrient #:name "Testium")) 105 (define zr (get-nutrient #:name "Zeroium")) 106 107 (define nv-hash (hash ex 100 ig 50 ts 150 zr 0)) 108 (define sorted (get-sorted-nutrient-values nv-hash)) 109 110 ;; Should exclude zero values 111 (check-equal? (length sorted) 3) 112 ;; Should be sorted descending by value 113 (check-equal? (cdr (first sorted)) 150) ; Testium 114 (check-equal? (cdr (second sorted)) 100) ; Examplium 115 (check-equal? (cdr (third sorted)) 50) ; Ignorium 116 ;; Zeroium should not be in the list 117 (check-false (member zr (map car sorted)))) 118 119 (test-case "Get sorted nutrient values with all zeros returns empty" 120 (define ex (get-nutrient #:name "Examplium")) 121 (define ig (get-nutrient #:name "Ignorium")) 122 123 (define nv-hash (hash ex 0 ig 0)) 124 (define sorted (get-sorted-nutrient-values nv-hash)) 125 126 (check-equal? (length sorted) 0)) 127 128 (test-case "Get sorted nutrient values with negatives excluded" 129 (define ex (get-nutrient #:name "Examplium")) 130 (define ig (get-nutrient #:name "Ignorium")) 131 132 ;; Note: nutrient-value? contract should prevent this, but testing the function 133 (define nv-hash (hash ex 100 ig -50)) 134 (define sorted (get-sorted-nutrient-values nv-hash)) 135 136 (check-equal? (length sorted) 1) 137 (check-equal? (cdr (first sorted)) 100)) 138 139 #;(test-case "Update nutrient values" 140 (define ex (get-nutrient #:name "Examplium")) 141 (define ig (get-nutrient #:name "Ignorium")) 142 143 ;; Create initial values 144 (define nvs-id 145 (insert-id (query (current-conn) 146 (insert #:into nutrient_value_sets 147 #:set [nutrient_measurement_id ,sql-null] 148 [crop_requirement_id ,sql-null] 149 [fertilizer_product_id ,sql-null])))) 150 151 (define initial-hash (hash ex 100 ig 50)) 152 (insert-nutrient-values (current-conn) nvs-id initial-hash) 153 154 ;; Update values 155 (define updated-hash (hash ex 200 ig 75)) 156 (update-nutrient-values! (current-conn) nvs-id updated-hash) 157 158 ;; Verify updates 159 (define ex-value 160 (query-value (current-conn) 161 (select value_ppm 162 #:from nutrient_values 163 #:where (and (= value_set_id ,nvs-id) 164 (= nutrient_id ,(nutrient-id ex)))))) 165 (check-= ex-value 200 0.001) 166 167 (define ig-value 168 (query-value (current-conn) 169 (select value_ppm 170 #:from nutrient_values 171 #:where (and (= value_set_id ,nvs-id) 172 (= nutrient_id ,(nutrient-id ig)))))) 173 (check-= ig-value 75 0.001)) 174 175 (test-case "Residuals to nutrient value hash conversion" 176 (define ex (get-nutrient #:name "Examplium")) 177 (define ig (get-nutrient #:name "Ignorium")) 178 179 (define residuals 180 (list (vector (nutrient-id ex) "Examplium" "Examplium" "Ex" 123.45) 181 (vector (nutrient-id ig) "Ignorium" "Ignorium" "Ig" 67.89))) 182 183 (define nv-hash (residuals->nutrient-value-hash residuals)) 184 185 (check-equal? (hash-count nv-hash) 2) 186 (check-= (hash-ref nv-hash ex) 123.45 0.001) 187 (check-= (hash-ref nv-hash ig) 67.89 0.001)) 188 189 (test-case "Residuals to nutrient value hash with empty list" 190 (define nv-hash (residuals->nutrient-value-hash '())) 191 (check-true (hash-empty? nv-hash))) 192 193 (test-case "Residuals to nutrient value hash preserves all fields" 194 (define residuals (list (vector 1 "Examplium" "Examplium-FR" "Ex" 100.0))) 195 196 (define nv-hash (residuals->nutrient-value-hash residuals)) 197 (define nutrient-key (car (hash-keys nv-hash))) 198 199 (check-equal? (nutrient-id nutrient-key) 1) 200 (check-equal? (nutrient-canonical-name nutrient-key) "Examplium") 201 (check-equal? (nutrient-french-name nutrient-key) "Examplium-FR") 202 (check-equal? (nutrient-formula nutrient-key) "Ex") 203 (check-= (hash-ref nv-hash nutrient-key) 100.0 0.001))))) 204