Enhance KPI calculation scripts and reporting:

- Update trend categorization thresholds in KPI calculations for clarity. - Improve comments for better understanding of trend interpretations. - Refactor report generation to use consistent terminology for trends. - Add batch pipeline runner for weekly reporting across multiple dates. - Minor formatting adjustments across various scripts for consistency.
2026-02-24 10:48:17 +01:00 · 2026-02-24 10:48:17 +01:00 · 9afceea121
parent fb5dbb7651
commit 9afceea121
8 changed files with 194 additions and 43 deletions
--- a/r_app/80_calculate_kpis.R
+++ b/r_app/80_calculate_kpis.R
@ -80,8 +80,9 @@
 FOUR_WEEK_TREND_STRONG_GROWTH_MIN <- 0.5
 FOUR_WEEK_TREND_GROWTH_MIN <- 0.1
 FOUR_WEEK_TREND_GROWTH_MAX <- 0.5
-FOUR_WEEK_TREND_NO_GROWTH_RANGE <- 0.1
-FOUR_WEEK_TREND_DECLINE_MAX <- -0.1
+FOUR_WEEK_TREND_NO_GROWTH_RANGE <- 0.1  # Stable range: -0.1 to +0.1
+FOUR_WEEK_TREND_DECLINE_MAX <- -0.1    # Boundary between stable and decline
+FOUR_WEEK_TREND_WEAK_DECLINE_MAX <- -0.3  # Boundary between weak and strong decline
 FOUR_WEEK_TREND_DECLINE_MIN <- -0.5
 FOUR_WEEK_TREND_STRONG_DECLINE_MAX <- -0.5

@ -140,15 +141,10 @@ suppressPackageStartupMessages({
  library(readxl)    # For reading harvest.xlsx (harvest dates for field mapping)
  library(writexl)   # For writing Excel outputs (KPI summary tables)
  library(progress)  # For progress bars during field processing
-  
+   
  # ML models (for yield prediction KPI)
  library(caret)     # For training Random Forest with cross-validation
  library(CAST)      # For Forward Feature Selection in caret models
-  
-  # ML models (for yield prediction KPI)
-  library(caret)     # For training Random Forest with cross-validation
-  library(CAST)      # For Forward Feature Selection in caret models
-  

 })

--- a/r_app/80_utils_agronomic_support.R
+++ b/r_app/80_utils_agronomic_support.R
@ -382,18 +382,25 @@ calculate_growth_decline_kpi <- function(ci_values_list) {
    
    result$four_week_trend[field_idx] <- round(as.numeric(slope), 3)
    
-    if (slope > 0.1) {
+    # Categorize trend using consistent thresholds (note: must use global constants if available)
+    # Category ranges:
+    #  slope >= 0.5:  Strong growth (↑↑)
+    #  0.1 <= slope < 0.5:  Weak growth (↑)
+    #  -0.1 <= slope < 0.1: Stable (→)
+    #  -0.3 < slope < -0.1: Weak decline (↓)
+    #  slope <= -0.3:  Strong decline (↓↓)
+    if (slope >= 0.5) {
      result$trend_interpretation[field_idx] <- "Strong growth"
      result$decline_severity[field_idx] <- "None"
-    } else if (slope > 0) {
+    } else if (slope >= 0.1) {
      result$trend_interpretation[field_idx] <- "Weak growth"
      result$decline_severity[field_idx] <- "None"
-    } else if (slope > -0.1) {
-      result$trend_interpretation[field_idx] <- "Slight decline"
-      result$decline_severity[field_idx] <- "Low"
+    } else if (slope >= -0.1) {
+      result$trend_interpretation[field_idx] <- "Stable"
+      result$decline_severity[field_idx] <- "None"
    } else if (slope > -0.3) {
-      result$trend_interpretation[field_idx] <- "Moderate decline"
-      result$decline_severity[field_idx] <- "Medium"
+      result$trend_interpretation[field_idx] <- "Weak decline"
+      result$decline_severity[field_idx] <- "Low"
    } else {
      result$trend_interpretation[field_idx] <- "Strong decline"
      result$decline_severity[field_idx] <- "High"
@ -852,7 +859,7 @@ calculate_all_field_analysis_agronomic_support <- function(
        })
      }
    }
-    
+     
  } else {
    stop("ERROR: Per-field mosaic structure required (weekly_mosaic/{FIELD_NAME}/week_WW_YYYY.tif)")
  }
--- a/r_app/80_utils_cane_supply.R
+++ b/r_app/80_utils_cane_supply.R
@ -375,7 +375,7 @@ calculate_farm_level_kpis <- function(field_analysis_df, current_week, current_y
    week = current_week,
    year = current_year,
    date = as.character(end_date)
-  )
+  ) 
  
  # Print summaries
  cat("\n--- PHASE DISTRIBUTION ---\n")
--- a/r_app/80_utils_common.R
+++ b/r_app/80_utils_common.R
@ -304,7 +304,7 @@ bin_percentage <- function(pct) {
  else if (pct >= 20) return("20-30%")
  else if (pct >= 10) return("10-20%")
  else return("0-10%")
-}
+} 

 #' Get CI percentile range (10th to 90th)
 get_ci_percentiles <- function(ci_values) {
--- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd
+++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd
@ -8,7 +8,7 @@ params:
  borders: FALSE
  ci_plot_type: "both"
  colorblind_friendly: TRUE
-  language: "en"
+  language: "en" # Language code for translations (e.g., "en", "es", "pt-br")
  facet_by_season: FALSE
  x_axis_unit: "days"
 output:
@ -571,10 +571,10 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
  if (!is.null(summary_tables$growth_decline) && nrow(summary_tables$growth_decline) > 0) {
    cat("\n\n", t("growth_trend"))
    growth_counts <- summary_tables$growth_decline %>%
-      dplyr::select(trend_interpretation, count = field_count)
+      dplyr::select(trend = trend_interpretation, count = field_count)
    
    for (i in seq_len(nrow(growth_counts))) {
-      trend <- growth_counts$trend_interpretation[i]
+      trend <- growth_counts$trend[i]
      count <- growth_counts$count[i]
      if (!is.na(trend) && !is.na(count) && count > 0) {
        cat(" -", t("trend_status"))
@ -621,7 +621,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
    kpi_display_order <- list(
      uniformity = list(display = "Field Uniformity", level_col = "interpretation", count_col = "field_count"),
      area_change = list(display = "Area Change", level_col = "interpretation", count_col = "field_count"),
-      growth_decline = list(display = "Growth Decline (4-Week Trend)", level_col = "trend_interpretation", count_col = "field_count"),
+      growth_decline = list(display = "4-Week Trend", level_col = "trend_interpretation", count_col = "field_count"),
      patchiness = list(display = "Field Patchiness", level_col = "gini_category", count_col = "field_count", detail_col = "patchiness_risk"),
      tch_forecast = list(display = "TCH Forecasted", level_col = "tch_category", detail_col = "range", count_col = "field_count"),
      gap_filling = list(display = "Gaps", level_col = "gap_level", count_col = "field_count")
@ -641,9 +641,40 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
        display_level <- df[[level_col]]
      }

+      # Helper function to convert trend interpretation to text + arrow format
+      # Works on vectors of text - handles both old and new category names
+      add_trend_arrows <- function(text_vec) {
+        # Handle NA and empty values
+        text_lower <- tolower(as.character(text_vec))
+        
+        # Use sapply to apply mapping logic to each element
+        sapply(text_lower, function(text) {
+          if (is.na(text) || text == "") return(NA_character_)
+          
+          # Map trend categories to text with arrows for KPI table
+          # Handles both OLD names (moderate/slight decline) and NEW names (weak/strong)
+          if (grepl("strong growth", text)) {
+            "Strong Growth (↑↑)"
+          } else if (grepl("weak growth", text)) {
+            "Weak Growth (↑)"
+          } else if (grepl("stable|no growth", text)) {
+            "Stable (→)"
+          } else if (grepl("weak decline", text)) {
+            "Weak Decline (↓)"
+          } else if (grepl("slight decline|moderate decline", text)) {
+            # Map old category names to new arrow format
+            "Weak Decline (↓)"
+          } else if (grepl("strong decline", text)) {
+            "Strong Decline (↓↓)"
+          } else {
+            as.character(text)
+          }
+        }, USE.NAMES = FALSE)
+      }
+
      df %>%
        dplyr::transmute(
-          Level = as.character(display_level),
+          Level = if (level_col == "trend_interpretation") add_trend_arrows(display_level) else as.character(display_level),
          Count = as.integer(round(as.numeric(.data[[count_col]]))),
          Percent = if (is.na(total)) {
            NA_real_
@ -1465,14 +1496,14 @@ tryCatch({
            kpi_parts <- c(kpi_parts, sprintf("**Δ%s:** %s%.2f", t("CI"), change_sign, field_kpi$Weekly_CI_Change))
          }
          
-          # Compact trend display with symbols
+          # Compact trend display with symbols (arrows only)
          trend_compact <- case_when(
            grepl("Strong growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑↑",
-            grepl("Growth|Increasing", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑",
+            grepl("Weak growth|Growth|Increasing", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑",
            grepl("Stable|No growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "→",
-            grepl("Slight decline", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓",
+            grepl("Weak decline", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓",
            grepl("Strong decline|Severe", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓↓",
-            TRUE ~ field_kpi$Trend_Interpretation
+            TRUE ~ "?"  # Fallback if no match found (shows as ? in report)
          )
          kpi_parts <- c(kpi_parts, sprintf("**%s:** %s", t("Trend"), trend_compact))
          
@ -1483,8 +1514,7 @@ tryCatch({
          kpi_parts <- c(
            kpi_parts,
            sprintf("**%s:** %.0f%%", t("Gaps"), field_kpi$Gap_Score),
-            sprintf("**%s:** %s", t("Patchiness"), t(field_kpi$Patchiness_Risk)),
-            sprintf("**%s:** %s", t("Decline"), t(field_kpi$Decline_Severity))
+            sprintf("**%s:** %s", t("Patchiness"), t(field_kpi$Patchiness_Risk))
          )
          
          cat(paste(kpi_parts, collapse = " | "), "\n\n")  # Double newline for markdown paragraph break
@ -1595,6 +1625,7 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field
    )
  
  # Add Weekly_CI_Change if it exists in the data (note: capital C and I)
+  # Replace Decline_Severity with Trend_Interpretation (arrows only)
  if ("Weekly_CI_Change" %in% names(field_details_clean)) {
    field_details_clean <- field_details_clean %>%
      mutate(Weekly_CI_Change = round(Weekly_CI_Change, 2)) %>%
@ -1605,7 +1636,7 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field
        weekly_ci_change = Weekly_CI_Change,
        yield_forecast = TCH_Forecasted,
        gap_score = Gap_Score,
-        decline_risk = Decline_Severity,
+        trend = Trend_Interpretation,
        patchiness_risk = Patchiness_Risk,
        cv_value = CV
      )
@ -1617,19 +1648,26 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field
        mean_ci = Mean_CI,
        yield_forecast = TCH_Forecasted,
        gap_score = Gap_Score,
-        decline_risk = Decline_Severity,
+        trend = Trend_Interpretation,
        patchiness_risk = Patchiness_Risk,
        cv_value = CV
      )
  }
  
-  # Translate risk levels
+  # Convert trend to arrows only (no text, just symbols)
+  # Translate patchiness_risk levels
  field_details_clean <- field_details_clean %>%
    mutate(
-      across(
-        c(decline_risk, patchiness_risk), 
-        ~ sapply(.x, t)
-      )
+      # Map trend categories to arrows only
+      trend = case_when(
+        grepl("Strong growth", trend, ignore.case = TRUE) ~ "↑↑",
+        grepl("Weak growth", trend, ignore.case = TRUE) ~ "↑",
+        grepl("Stable", trend, ignore.case = TRUE) ~ "→",
+        grepl("Weak decline", trend, ignore.case = TRUE) ~ "↓",
+        grepl("Strong decline", trend, ignore.case = TRUE) ~ "↓↓",
+        TRUE ~ trend
+      ),
+      patchiness_risk = sapply(patchiness_risk, t)
    )
  
  # Translation labels for flextable
@ -1640,7 +1678,7 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field
    weekly_ci_change = t("weekly_ci_change"),
    yield_forecast = t("yield_forecast"),
    gap_score = t("gap_score"),
-    decline_risk = t("decline_risk"),
+    trend = t("Trend"),
    patchiness_risk = t("patchiness_risk"),
    cv_value = t("cv_value")
  )
@ -1653,7 +1691,7 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field
    set_table_properties(width = 1, layout = "autofit")  # Fit to 100% page width with auto-adjust
  
  knit_print(ft)
-}
+} 
 ```

 \newpage
@ -1703,10 +1741,10 @@ img_path <- ifelse(file.exists(target_img), target_img, "CI_graph_example.png")
    - `r t("kpi_iv")`
        - `r t("kpi_iv_calc")`
        - `r t("kpi_categories")`
-            - `r t("kpi_iv_strong")`
-            - `r t("kpi_iv_weak")`
-            - `r t("kpi_iv_sli_decline")`
-            - `r t("kpi_iv_mod_decline")`
+            - `r t("kpi_iv_str_improve")`
+            - `r t("kpi_iv_weak_improve")`
+            - `r t("kpi_iv_stable")`
+            - `r t("kpi_iv_weak_decline")`
            - `r t("kpi_iv_str_decline")`
        - `r t("kpi_iv_why")`
   
--- a/r_app/91_CI_report_with_kpis_cane_supply.Rmd
+++ b/r_app/91_CI_report_with_kpis_cane_supply.Rmd
@ -66,7 +66,7 @@ tmap_mode("plot")  # CRITICAL: Must be "plot" mode for legends outside to render
 tmap_options(component.autoscale = FALSE)

 # Load custom utility functions
-tryCatch({
+tryCatch({ 
  source("r_app/90_report_utils.R")
 }, error = function(e) {
  message(paste("Error loading 90_report_utils.R:", e$message))
--- a/r_app/batch_pipeline.R
+++ b/r_app/batch_pipeline.R
@ -0,0 +1,110 @@
+# ============================================================================
+# BATCH PIPELINE RUNNER: Scripts 40, 80, 90 for Multiple Dates
+# ============================================================================
+# Purpose: Run weekly reporting pipeline for multiple dates (Jan 21, 2026 - Feb 18, 2026)
+# Project: aura
+# ============================================================================
+
+suppressPackageStartupMessages({
+  library(lubridate)
+  library(rmarkdown)
+})
+
+# Configuration
+PROJECT <- "aura"
+START_DATE <- as.Date("2026-01-21")
+END_DATE <- as.Date("2026-02-18")
+OFFSET <- 7
+
+# Generate date sequence (every 7 days)
+date_sequence <- seq(START_DATE, END_DATE, by = "7 days")
+
+cat("\n========================================================\n")
+cat("BATCH PIPELINE RUNNER for AURA Project\n")
+cat("========================================================\n")
+cat(sprintf("Project: %s\n", PROJECT))
+cat(sprintf("Date range: %s to %s\n", format(START_DATE), format(END_DATE)))
+cat(sprintf("Interval: Every %d days\n", OFFSET))
+cat(sprintf("Total dates to process: %d\n", length(date_sequence)))
+cat(sprintf("Dates: %s\n", paste(format(date_sequence), collapse = ", ")))
+cat("========================================================\n\n")
+
+# Process each date
+for (i in seq_along(date_sequence)) {
+  current_date <- date_sequence[i]
+  date_str <- format(current_date, "%Y-%m-%d")
+  
+  cat("\n")
+  cat(strrep("=", 70), "\n")
+  cat(sprintf("PROCESSING DATE: %s (%d of %d)\n", date_str, i, length(date_sequence)))
+  cat(strrep("=", 70), "\n\n")
+  
+  # ==== SCRIPT 40: Create Weekly Mosaic ====
+ # cat(sprintf("[%s] Running Script 40: Weekly Mosaic Creation\n", Sys.time()))
+ # tryCatch({
+  #  r_path <- "C:\\Program Files\\R\\R-4.4.3\\bin\\x64\\Rscript.exe"
+  #  script_40 <- "r_app/40_mosaic_creation_per_field.R"
+  #  cmd_40 <- c(script_40, date_str, as.character(OFFSET), PROJECT)
+  #  
+  #  result_40 <- system2(r_path, args = cmd_40)
+  #  
+  #  if (result_40 == 0) {
+  #    cat(sprintf("[%s] ✓ Script 40 completed successfully\n\n", Sys.time()))
+  #  } else {
+  #    cat(sprintf("[%s] ✗ Script 40 failed with exit code %d (continuing anyway)\n\n", Sys.time(), result_40))
+ #   }
+ # }, error = function(e) {
+ #   cat(sprintf("[ERROR] Script 40 error: %s (continuing anyway)\n\n", e$message))
+ # })
+  
+  # ==== SCRIPT 80: Calculate KPIs ====
+  cat(sprintf("[%s] Running Script 80: Calculate KPIs\n", Sys.time()))
+  tryCatch({
+    r_path <- "C:\\Program Files\\R\\R-4.4.3\\bin\\x64\\Rscript.exe"
+    script_80 <- "r_app/80_calculate_kpis.R"
+    # Note: R80 argument order is [END_DATE] [PROJECT] [OFFSET]
+    cmd_80 <- c(script_80, date_str, PROJECT, as.character(OFFSET))
+    
+    result_80 <- system2(r_path, args = cmd_80)
+    
+    if (result_80 == 0) {
+      cat(sprintf("[%s] ✓ Script 80 completed successfully\n\n", Sys.time()))
+    } else {
+      cat(sprintf("[%s] ✗ Script 80 failed with exit code %d (continuing anyway)\n\n", Sys.time(), result_80))
+    }
+  }, error = function(e) {
+    cat(sprintf("[ERROR] Script 80 error: %s (continuing anyway)\n\n", e$message))
+  })
+  
+  # ==== SCRIPT 90: Generate Report ====
+#  cat(sprintf("[%s] Running Script 90: Generate Agronomic Support Report\n", Sys.time()))
+  #tryCatch({
+    #output_filename <- sprintf("SmartCane_Report_agronomic_support_%s_%s.docx", PROJECT, date_str)
+ #   
+ #   render(
+ #     "r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
+ #     params = list(data_dir = PROJECT, report_date = as.Date(date_str)),
+ #     output_file = output_filename,
+ #     output_dir = file.path("laravel_app/storage/app", PROJECT, "reports"),
+ #     quiet = FALSE
+ #   )
+ #   
+#    cat(sprintf("[%s] ✓ Script 90 completed successfully\n", Sys.time()))
+#    cat(sprintf("    Output: laravel_app/storage/app/%s/reports/%s\n\n", PROJECT, output_filename))
+#  }, error = function(e) {
+#    cat(sprintf("[%s] ✗ Script 90 failed: %s (continuing anyway)\n\n", Sys.time(), e$message))
+#  })
+}
+
+# Summary
+cat("\n")
+cat(strrep("=", 70), "\n")
+cat("BATCH PROCESSING COMPLETE\n")
+cat(strrep("=", 70), "\n")
+cat(sprintf("Processed %d dates from %s to %s\n", 
+            length(date_sequence), 
+            format(START_DATE), 
+            format(END_DATE)))
+cat("Check output directory for generated reports\n")
+cat(sprintf("Reports location: laravel_app/storage/app/%s/reports/\n", PROJECT))
+cat(strrep("=", 70), "\n\n")
--- a/r_app/translations/translations.xlsx
+++ b/r_app/translations/translations.xlsx