diff options
Diffstat (limited to 'services/nnls.rkt')
| -rw-r--r-- | services/nnls.rkt | 153 |
1 files changed, 66 insertions, 87 deletions
diff --git a/services/nnls.rkt b/services/nnls.rkt index abc76fe..a5800f3 100644 --- a/services/nnls.rkt +++ b/services/nnls.rkt @@ -5,30 +5,41 @@ (require math/array math/matrix "../models/nutrient.rkt" + "../models/fertilizer-product.rkt" "../models/nutrient-measurement.rkt" - "../models/nutrient-target.rkt" - "../models/fertilizer-product.rkt") + "../models/crop-rotation.rkt" + "../models/crop-requirement.rkt") -(define (find-ferti-recipe) +(define (find-ferti-recipe date-string) (define fertilizers (get-fertilizer-products)) - (define solution-array (solve-nnls fertilizers)) - (for/list ([fertilizer (in-list fertilizers)] + (define measurement-values + (nutrient-measurement-values + (or (get-nutrient-measurement #:date date-string) + (error 'nnls + "Can't compute the Ferti recipe (missing nutrient measurement for ~a)" + date-string)))) + (define rotation-values + (average-crop-requirement-nutrient-values + (crop-rotation-requirements + (or + (get-crop-rotation #:date date-string) + (error 'nnls "Can't compute the Ferti recipe (missing crop rotation for ~a)" date-string))))) + (define solution-array (solve-nnls fertilizers measurement-values rotation-values)) + (for/hash ([fertilizer (in-list fertilizers)] [quantity (in-array solution-array)]) - (cons fertilizer quantity))) + (values fertilizer quantity))) -(define (solve-nnls fertilizers) +(define (solve-nnls fertilizers measurement-values rotation-values) (define nutrients (get-nutrients)) (define fertilizer-product-matrix (get-fertilizer-product-matrix nutrients fertilizers)) (define deficits (->col-matrix (for/list ([n nutrients]) - (define latest-measurement (get-latest-nutrient-measurement-value n)) - (define latest-target (get-latest-nutrient-target-value n)) + (define measured (hash-ref measurement-values n 0)) + (define required (hash-ref rotation-values n 0)) (define deficit - (cond - [(false? latest-target) 0] - [(or (false? latest-measurement) (zero? latest-measurement)) latest-target] - [(and (number? latest-measurement) (number? latest-target)) - (* 100 (/ (- latest-target latest-measurement) latest-measurement))])) + (if (zero? required) + 0 + (* 100 (/ (- required measured) required)))) deficit))) (define error-threshold 10e-4) (lawson-hanson-1974 fertilizer-product-matrix deficits error-threshold)) @@ -178,19 +189,23 @@ "../db/conn.rkt" "../db/migrations.rkt") - (define test-date "2025-01-01") - (run-tests (test-suite "NNLS" + #:before (λ () + (connect! #:path 'memory) + (migrate-all!) + (create-nutrient! "Nitrogen" "Azote" "N") + (create-nutrient! "Phosphorus" "Phosphore" "P") + (create-nutrient! "Potassium" "Potassium" "K")) + #:after (λ () (disconnect!)) + (test-case "Build fertilizer product matrix" - (connect! #:path 'memory) - (migrate-all!) + (define n (get-nutrient #:name "Nitrogen")) + (define p (get-nutrient #:name "Phosphorus")) - (define n1 (create-nutrient! "N1" "" "N1")) - (define n2 (create-nutrient! "N2" "" "N2")) - (define nutrients (list n1 n2)) + (define nutrients (list n p)) - (define f1 (create-fertilizer-product! "F1" "F1" (hash n1 10 n2 20))) - (define f2 (create-fertilizer-product! "F2" "F2" (hash n1 30 n2 5))) + (define f1 (create-fertilizer-product! "F1" "F1" (hash n 10 p 20))) + (define f2 (create-fertilizer-product! "F2" "F2" (hash n 30 p 5))) (define fertilizers (list f1 f2)) (define matrix (get-fertilizer-product-matrix nutrients fertilizers)) @@ -198,9 +213,7 @@ (check-= (matrix-ref matrix 0 0) 10 0 "N1 in F1") (check-= (matrix-ref matrix 0 1) 30 0 "N1 in F2") (check-= (matrix-ref matrix 1 0) 20 0 "N2 in F1") - (check-= (matrix-ref matrix 1 1) 5 0 "N2 in F2") - - (disconnect!)) + (check-= (matrix-ref matrix 1 1) 5 0 "N2 in F2")) (test-case "Single nutrient, single fertilizer" (define A (matrix [[2]])) @@ -254,72 +267,40 @@ (check-= (matrix-ref result 1 0) 0.0 ε "x2 should be 0")) (test-case "Ferti recipe" - (connect! #:path 'memory) - (migrate-all!) - - (define nitrogen (create-nutrient! "Nitrogen" "" "N")) - (define phosphorus (create-nutrient! "Phosphorus" "" "P")) - - (create-nutrient-measurement! test-date (hash nitrogen 0 phosphorus 0)) - (create-nutrient-target! test-date (hash nitrogen 100 phosphorus 50)) - - (create-fertilizer-product! "Nitrogen" "King Nitrogen" (hash nitrogen 100)) - (create-fertilizer-product! "Phosphorus" - "Phosphorescent Baboon" - (hash nitrogen 10 phosphorus 100)) - (create-fertilizer-product! "Diluted phosphorus" - "John's Phosphorus" - (hash nitrogen 3 phosphorus 30)) - - (define recipe (find-ferti-recipe)) + (define test-date "2025-01-01") + (define n (get-nutrient #:name "Nitrogen")) + (define p (get-nutrient #:name "Phosphorus")) + (define k (get-nutrient #:name "Potassium")) - (check-equal? (length recipe) 3 "Should have 3 fertilizer products") + (create-nutrient-measurement! test-date (hash n 0 p 0)) + (define test-crop-requirement + (create-crop-requirement! "Test requirement" (hash n 100 p 50))) + (create-crop-rotation! test-date (hash test-crop-requirement 100)) - (for ([pair recipe]) - (check-true (>= (cdr pair) 0) "Fertilizer quantity should be non-negative")) + (create-fertilizer-product! "Nitrogen" "King Nitrogen" (hash n 100)) + (create-fertilizer-product! "Phosphorus" "Phosphorescent Baboon" (hash n 10 p 100)) + (create-fertilizer-product! "Diluted phosphorus" "John's Phosphorus" (hash n 3 p 30)) - (disconnect!)) + (define recipe (find-ferti-recipe test-date)) - ;; Test deficit calculation edge cases - (test-case "Deficit calculation with missing data" - (connect! #:path 'memory) - (migrate-all!) + (check-equal? (hash-count recipe) 5 "Should have 5 fertilizer products") - (define n (create-nutrient! "TestNutrient" "" "TN")) + (for ([(fertilizer quantity) (in-hash recipe)]) + (check-true (>= quantity 0) "Fertilizer quantity should be non-negative"))) - ;; No measurement, no target - (check-false (get-latest-nutrient-measurement-value n)) - (check-false (get-latest-nutrient-target-value n)) - - ;; Add only target - (create-nutrient-target! test-date (hash n 100)) - (check-= (get-latest-nutrient-target-value n) 100 0) - - ;; Add measurement - (create-nutrient-measurement! test-date (hash n 50)) - (define measured (get-latest-nutrient-measurement-value n)) - (define targeted (get-latest-nutrient-target-value n)) - - ;; Deficit should be 100% (from 50 to 100) - (define deficit (* 100 (/ (- targeted measured) measured))) - (check-= deficit 100.0 0.01 "Deficit should be 100%") - - (disconnect!)) - - ;; Test recipe with realistic constraints (test-case "Recipe calculation with real-world scenario" - (connect! #:path 'memory) - (migrate-all!) - - (define n (create-nutrient! "N" "" "N")) - (define p (create-nutrient! "P" "" "P")) - (define k (create-nutrient! "K" "" "K")) + (define test-date "2025-01-02") + (define n (get-nutrient #:name "Nitrogen")) + (define p (get-nutrient #:name "Phosphorus")) + (define k (get-nutrient #:name "Potassium")) ;; Current levels (create-nutrient-measurement! test-date (hash n 50 p 10 k 100)) ;; Target levels - (create-nutrient-target! test-date (hash n 150 p 30 k 200)) + (define test-crop-requirement + (create-crop-requirement! "Test requirement 2" (hash n 150 p 30 k 200))) + (create-crop-rotation! test-date (hash test-crop-requirement 100)) ;; Fertilizers with different NPK ratios (create-fertilizer-product! "" "Balanced" (hash n 100 p 100 k 100)) @@ -327,14 +308,12 @@ (create-fertilizer-product! "Phosphorus blend" "High-P" (hash n 50 p 200 k 50)) (create-fertilizer-product! "Potassium blend" "High-K" (hash n 50 p 50 k 200)) - (define recipe (find-ferti-recipe)) + (define recipe (find-ferti-recipe test-date)) - (check-equal? (length recipe) 4 "Should have 4 fertilizer options") + (check-equal? (hash-count recipe) 9 "Recipe should have 9 fertilizers") ;; Verify solution is non-negative - (for ([pair recipe]) - (check-true (>= (cdr pair) 0) + (for ([(fertilizer quantity) (in-hash recipe)]) + (check-true (>= quantity 0) (format "~a quantity must be non-negative" - (fertilizer-name (car pair))))) - - (disconnect!))))) + (fertilizer-product-name fertilizer)))))))) |