From 0411d731cf2018794b4f10154e3af8c875faa99c Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sun, 30 Nov 2025 15:06:48 +0100 Subject: Introduce crop rotations. These will probably replace nutrient targets as the main entry point for nutrient requirement calculations. --- db/migrations.rkt | 24 +++++++++ db/seed.rkt | 9 ++++ handlers.rkt | 63 +++++++++++----------- models/crop-rotation.rkt | 138 +++++++++++++++++++++++++++++++++++++++++++++++ views.rkt | 55 ++++++++++++------- 5 files changed, 238 insertions(+), 51 deletions(-) create mode 100644 models/crop-rotation.rkt diff --git a/db/migrations.rkt b/db/migrations.rkt index dfb216e..86c9cce 100644 --- a/db/migrations.rkt +++ b/db/migrations.rkt @@ -143,6 +143,30 @@ #:constraints (primary-key id) (foreign-key crop_id #:references (crops id) #:on-delete #:cascade)))) +(define-migration "create table crop_rotations" + (list (create-table #:if-not-exists crop_rotations + #:columns [id integer #:not-null] + ;; ISO8601 date + [rotation_date text #:not-null] + [nutrient_measurement_id integer] + #:constraints (primary-key id) + (foreign-key nutrient_measurement_id + #:references (nutrient_measurements id) + #:on-delete + #:set-null) + (unique rotation_date)))) + +(define-migration + "create table crop_rotation_requirements" + (list (create-table + #:if-not-exists crop_rotation_requirements + #:columns [crop_rotation_id integer #:not-null] + [crop_requirement_id integer #:not-null] + [proportion_percent integer #:not-null] + #:constraints (primary-key crop_rotation_id crop_requirement_id) + (foreign-key crop_rotation_id #:references (crop_rotation id) #:on-delete #:cascade) + (foreign-key crop_requirement_id #:references (crop_requirement id) #:on-delete #:cascade)))) + ;;;;;;;;;;;;;; ;; FERTILIZERS ;;;;;;;;;;;;;; diff --git a/db/seed.rkt b/db/seed.rkt index d767d63..8d671ba 100644 --- a/db/seed.rkt +++ b/db/seed.rkt @@ -9,6 +9,7 @@ "../models/nutrient-measurement.rkt" "../models/crop.rkt" "../models/crop-requirement.rkt" + "../models/crop-rotation.rkt" "../models/fertilizer-product.rkt") (define (seed-database!) @@ -20,6 +21,7 @@ seed-historical-nutrient-measurements! seed-crops! seed-crop-requirements! + seed-initial-crop-rotation! seed-existing-fertilizer-products!)) (define (seed-nutrients!) @@ -90,6 +92,13 @@ [else (create-crop-requirement! profile nutrient-values)])) (with-tx (csv-for-each row->seed! next-row))) +(define (seed-initial-crop-rotation!) + (define nm (get-latest-nutrient-measurement)) + (define generic-requirement (get-crop-requirement #:profile "générique croissance")) + (create-crop-rotation! (nutrient-measurement-date nm) + (hash generic-requirement 100) + #:nutrient-measurement (nutrient-measurement-id nm))) + (define-runtime-path fertilizer-products-csv "data/dolibarr_fertilizer_compositions_percentage.csv") (define (seed-existing-fertilizer-products!) (define next-row (make-csv-reader (open-input-file fertilizer-products-csv))) diff --git a/handlers.rkt b/handlers.rkt index a232e56..6141426 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -13,6 +13,7 @@ "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" + "models/crop-rotation.rkt" "models/fertilizer-product.rkt" "services/nnls.rkt") @@ -47,31 +48,31 @@ void)) (define-values (fapg-dispatch fapg-url) - (dispatch-rules [("index") #:method "get" index] - ;; Ferti - [("ferti" "index") #:method "get" ferti-index] - [("ferti" "measurements") #:method "get" ferti-measurements] - [("ferti" "targets") #:method "get" ferti-targets] - [("ferti" "recipe") #:method "get" ferti-recipe] - [("ferti" "fertilizers") #:method "get" ferti-fertilizers] - ;; Nutrient measurements - [("ferti" "measurement" "new") #:method "get" new-measurement] - [("ferti" "measurement" "create") #:method "post" create-measurement] - [("ferti" "measurement" (integer-arg)) #:method "get" show-measurement] - [("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement] - ;; Nutrient targets - [("ferti" "target" "new") #:method "get" new-target] - [("ferti" "target" "create") #:method "post" create-target] - [("ferti" "target" (integer-arg)) #:method "get" show-target] - [("ferti" "target" (integer-arg)) #:method "delete" destroy-target] - ;; Fertilizer products - [("ferti" "fertilizer" "new") #:method "get" new-fertilizer] - [("ferti" "fertilizer" "create") #:method "post" create-fertilizer] - [("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer] - [("ferti" "fertilizer" "destroy" (integer-arg)) #:method "get" destroy-fertilizer] - ;; Default - [("") #:method "get" index] - [else fallback])) + (dispatch-rules + [("index") #:method "get" index] + ;; Ferti + [("ferti" "index") #:method "get" ferti-index] + [("ferti" "measurements-and-rotations") #:method "get" ferti-measurements-and-rotations] + [("ferti" "recipe") #:method "get" ferti-recipe] + [("ferti" "fertilizers") #:method "get" ferti-fertilizers] + ;; Nutrient measurements + [("ferti" "measurement" "new") #:method "get" new-measurement] + [("ferti" "measurement" "create") #:method "post" create-measurement] + [("ferti" "measurement" (integer-arg)) #:method "get" show-measurement] + [("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement] + ;; Nutrient targets + [("ferti" "target" "new") #:method "get" new-target] + [("ferti" "target" "create") #:method "post" create-target] + [("ferti" "target" (integer-arg)) #:method "get" show-target] + [("ferti" "target" (integer-arg)) #:method "delete" destroy-target] + ;; Fertilizer products + [("ferti" "fertilizer" "new") #:method "get" new-fertilizer] + [("ferti" "fertilizer" "create") #:method "post" create-fertilizer] + [("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer] + [("ferti" "fertilizer" "destroy" (integer-arg)) #:method "get" destroy-fertilizer] + ;; Default + [("") #:method "get" index] + [else fallback])) (define (render-page xexpr) (response/xexpr #:preamble #"" xexpr)) @@ -87,15 +88,11 @@ (define (ferti-index _) (render-page (ferti-index-page))) -(define (ferti-measurements _) +(define (ferti-measurements-and-rotations _) (define nutrients (get-nutrients)) (define measurements (get-nutrient-measurements)) - (render-page (ferti-measurements-page nutrients measurements))) - -(define (ferti-targets _) - (define latest-measurement-hash (get-latest-nutrient-measurement-hash)) - (define latest-target-hash (get-latest-nutrient-target-hash)) - (render-page (ferti-targets-page latest-measurement-hash latest-target-hash))) + (define rotations (get-crop-rotations)) + (render-page (ferti-measurements-and-rotations-page nutrients measurements rotations))) (define (ferti-recipe _) (define ferti-recipe (find-ferti-recipe)) @@ -113,7 +110,7 @@ (define (create-measurement req) (define-values (measurement-date nutrient-values) (formlet-process (measurements-formlet) req)) (create-nutrient-measurement! measurement-date nutrient-values) - (redirect-to "/ferti/measurements")) + (redirect-to "/ferti/measurements-and-rotations")) (define (show-measurement _ id) (define nm (get-nutrient-measurement #:id id)) diff --git a/models/crop-rotation.rkt b/models/crop-rotation.rkt new file mode 100644 index 0000000..abff080 --- /dev/null +++ b/models/crop-rotation.rkt @@ -0,0 +1,138 @@ +#lang racket + +(provide crop-rotation + crop-rotation? + crop-rotation-id + (rename-out [crop-rotation-rotation-date crop-rotation-date] + [crop-rotation-requirement-proportions crop-rotation-requirements] + [crop-rotation-nutrient-measurement-id crop-rotation-measurement-id]) + (contract-out [create-crop-rotation! + (->* (string? requirement-proportion-hash/c) + (#:nutrient-measurement exact-nonnegative-integer?) + crop-rotation?)] + [get-crop-rotations (-> (listof crop-rotation?))] + [get-crop-rotation + (->* () (#:id crop-rotation-id? #:date string?) (or/c crop-rotation? #f))] + [get-latest-crop-rotation (-> (or/c crop-rotation? #f))] + [delete-crop-rotation! (-> crop-rotation-or-id/c void?)])) + +(require racket/contract + db + sql + "../db/conn.rkt" + "nutrient.rkt" + "crop-requirement.rkt") + +(struct crop-rotation (id rotation-date requirement-proportions nutrient-measurement-id) + #:transparent + #:guard (λ (id rotation-date requirement-proportions nutrient-measurement-id _) + (values id + rotation-date + requirement-proportions + (if (sql-null? nutrient-measurement-id) #f nutrient-measurement-id)))) + +(define crop-rotation-id? exact-nonnegative-integer?) +(define crop-rotation-or-id/c (or/c crop-rotation? crop-rotation-id?)) +(define requirement-proportion-hash/c (hash/c crop-requirement? (between/c 0 100) #:immutable #t)) + +(define (->cr-id cr-or-id) + (match cr-or-id + [(? crop-rotation-id? id) id] + [(crop-rotation id _ _ _) id] + [#f (error '->nt-id "#f can not be converted to an id")])) + +;; CREATE + +(define (create-crop-rotation! rotation-date + requirement-proportions + #:nutrient-measurement [nutrient-measurement-id #f]) + (or (get-crop-rotation #:date rotation-date) + (with-tx + (if nutrient-measurement-id + (query-exec (current-conn) + (insert #:into crop_rotations + #:set [rotation_date ,rotation-date] + [nutrient_measurement_id ,nutrient-measurement-id])) + (query-exec (current-conn) + (insert #:into crop_rotations #:set [rotation_date ,rotation-date]))) + (define cr-id + (query-value (current-conn) + (select id #:from crop_rotations #:where (= rotation_date ,rotation-date)))) + (for ([(r p) (in-hash requirement-proportions)]) + (query-exec (current-conn) + (insert #:into crop_rotation_requirements + #:set [crop_rotation_id ,cr-id] + [crop_requirement_id ,(crop-requirement-id r)] + [proportion_percent ,p]))) + (get-crop-rotation #:date rotation-date)))) + +;; READ + +(define joined + (table-expr-qq (inner-join (as crop_rotations cr) + (as crop_rotation_requirements crr) + #:on (= crr.crop_rotation_id cr.id)))) + +(define (residuals->requirement-proportion-hash residuals) + (for/hash ([r (in-list residuals)]) + (match-define (vector requirement-id proportion) r) + (values requirement-id proportion))) + +(define (grouped-row->crop-rotation grouped-row) + (match-define (vector cr-id cr-rotation-date cr-nutrient-measurement-id residuals) grouped-row) + (crop-rotation cr-id + cr-rotation-date + (residuals->requirement-proportion-hash residuals) + cr-nutrient-measurement-id)) + +(define (get-crop-rotations) + (define grouped-rows + (query-rows (current-conn) + (select cr.id + cr.rotation_date + cr.nutrient_measurement_id + crr.crop_requirement_id + crr.proportion_percent + #:from (TableExpr:AST ,joined) + #:order-by cr.rotation_date + #:desc) + #:group '#(0 1 2))) + (map grouped-row->crop-rotation grouped-rows)) + +(define (get-crop-rotation #:id [cr-id #f] #:date [rotation-date #f]) + (define where + (cond + [(and cr-id rotation-date) + (scalar-expr-qq (and (= cr.id ,cr-id) (= cr.rotation_date ,rotation-date)))] + [cr-id (scalar-expr-qq (= cr.id ,cr-id))] + [rotation-date (scalar-expr-qq (= cr.rotation_date ,rotation-date))] + [else (error 'get-crop-rotation "either #:id or #:date must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (select cr.id + cr.rotation_date + cr.nutrient_measurement_id + crr.crop_requirement_id + crr.proportion_percent + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where) + #:order-by cr.rotation_date + #:desc) + #:group '#(0 1 2))) + (match grouped-rows + ['() #f] + [(list grouped-row) (grouped-row->crop-rotation grouped-row)] + [many (error 'get-crop-rotation "expected 1 nutrient target, got ~a" (length many))])) + +(define (get-latest-crop-rotation) + (define rotations (get-crop-rotations)) + (if (null? rotations) + #f + (first rotations))) + +;; UPDATE + +;; DELETE + +(define (delete-crop-rotation! cr-or-id) + (query-exec (current-conn) (delete #:from crop_rotations #:where (= id ,(->cr-id cr-or-id))))) diff --git a/views.rkt b/views.rkt index 933594e..a7e9f1f 100644 --- a/views.rkt +++ b/views.rkt @@ -2,8 +2,7 @@ (provide index-page ferti-index-page - ferti-measurements-page - ferti-targets-page + ferti-measurements-and-rotations-page ferti-recipe-page ferti-fertilizers-page new-measurement-page @@ -21,6 +20,7 @@ "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" + "models/crop-rotation.rkt" "models/fertilizer-product.rkt") (define (page-template title body-xexpr) @@ -83,13 +83,12 @@ (li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/index")) "Accueil")) (li ((class "nav-item")) - (a ((class "nav-link") (aria-current "page") (href "/ferti/measurements")) "Relevés")) - (li ((class "nav-item")) - (a ((class "nav-link") (aria-current "page") (href "/ferti/targets")) "Cibles")) + (a ((class "nav-link") (aria-current "page") (href "/ferti/measurements-and-rotations")) + "Relevés & Cibles")) (li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/fertilizers")) "Intrants")) - (li ((class "nav-item")) - (a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©")))) + #;(li ((class "nav-item")) + (a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©")))) (define (ferti-index-page) (ferti-template @@ -100,19 +99,39 @@ (a ((class "btn btn-outline-primary") [href "/ferti/fertilizer/new"]) "Ajouter un intrant"))))) -(define (ferti-measurements-page nutrients measurements) +(define (ferti-measurements-and-rotations-page nutrients measurements rotations) + (define (maybe-rotation-for-measurement m) + (findf (λ (r) (= (crop-rotation-measurement-id r) (nutrient-measurement-id m))) rotations)) (define table - `(table ((class "table")) - (thead (tr (th "Date"))) - (tbody ,@(for/list ([m measurements]) - `(tr (td (a ((href ,(format "/ferti/measurement/~a" - (nutrient-measurement-id m)))) - ,(nutrient-measurement-date m)))))))) - (ferti-template `((h2 () "Relevés") (a ((class "btn btn-primary mb-3") [href - "/ferti/measurement/new"]) - "Ajouter un relevé") - ,table))) + `(table + ((class "table")) + (thead (tr (th "Date du relevé") (th "Relevé") (th "Cultures") (th "Recette"))) + (tbody + ,@(for/list ([m measurements]) + (define maybe-rotation (maybe-rotation-for-measurement m)) + `(tr (td ,(nutrient-measurement-date m)) + (td (a ((class "btn btn-outline-secondary") + (href ,(format "/ferti/measurement/~a" (nutrient-measurement-id m)))) + "Modifier")) + (td ,(if maybe-rotation + `(a ((class "btn btn-outline-secondary") + (href ,(format "/ferti/rotation/~a" (crop-rotation-id maybe-rotation)))) + "Modifier") + `(a ((class "btn btn-outline-primary") (href "/ferti/rotation/new")) + "Ajouter"))) + (td ,(if maybe-rotation + `(a ((class "btn btn-outline-secondary") + (href ,(format "/ferti/recipe/~a" (crop-rotation-date maybe-rotation)))) + "Consulter") + "—"))))))) + (ferti-template + `((h2 () "Relevés") + (div ((class "btn-group mb-3")) + (a ((class "btn btn-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé") + #;(a ((class "btn btn-secondary") [href "/ferti/target/new"]) "Créer une cible")) + ,table))) +#; (define (ferti-targets-page latest-measurement-hash latest-target-hash) (define table `(table ((class "table")) -- cgit v1.2.3