diff --git a/checkout b/checkout
deleted file mode 100644
index e69de29..0000000
diff --git a/r_app/80_calculate_kpis.R b/r_app/80_calculate_kpis.R
index 65e4bae..8b76ac0 100644
--- a/r_app/80_calculate_kpis.R
+++ b/r_app/80_calculate_kpis.R
@@ -368,13 +368,14 @@ main <- function() {
# Call with correct signature
kpi_results <- calculate_all_kpis(
+ report_date = end_date,
+ output_dir = reports_dir_kpi,
field_boundaries_sf = field_boundaries_sf,
- current_week = current_week,
- current_year = current_year,
- current_mosaic_dir = setup$weekly_mosaic_dir,
harvesting_data = harvesting_data,
- ci_rds_path = cumulative_CI_vals_dir,
- output_dir = reports_dir_kpi
+ cumulative_CI_vals_dir = cumulative_CI_vals_dir,
+ weekly_CI_mosaic = setup$weekly_mosaic_dir,
+ reports_dir = reports_dir_kpi,
+ project_dir = project_dir
)
cat("\n=== AURA KPI CALCULATION COMPLETE ===\n")
@@ -402,11 +403,9 @@ main <- function() {
previous_week <- weeks$previous_week
previous_year <- weeks$previous_year
- message(paste("Week:", current_week, "/ Year (ISO 8601):", year))
-
+ message(paste("Week:", current_week, "/ Year (ISO 8601):", current_year))
# Find per-field weekly mosaics
message("Finding per-field weekly mosaics...")
- single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, year)
if (!dir.exists(weekly_mosaic)) {
stop(paste("ERROR: weekly_mosaic directory not found:", weekly_mosaic,
@@ -422,7 +421,7 @@ main <- function() {
}
# Verify we have mosaics for this week
- single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, year)
+ single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, current_year)
per_field_files <- c()
for (field in field_dirs) {
field_mosaic_dir <- file.path(weekly_mosaic, field)
@@ -433,7 +432,7 @@ main <- function() {
}
if (length(per_field_files) == 0) {
- stop(paste("ERROR: No mosaics found for week", current_week, "year", year,
+ stop(paste("ERROR: No mosaics found for week", current_week, "year", current_year,
"\nExpected pattern:", single_file_pattern,
"\nChecked:", weekly_mosaic))
}
diff --git a/r_app/90_CI_report_with_kpis_simple.Rmd b/r_app/90_CI_report_with_kpis_simple.Rmd
index 365c0a7..0243b9f 100644
--- a/r_app/90_CI_report_with_kpis_simple.Rmd
+++ b/r_app/90_CI_report_with_kpis_simple.Rmd
@@ -73,31 +73,6 @@ tryCatch({
})
})
-# Function to determine field priority level based on CV and Moran's I
-# Returns: 1=Urgent, 2=Monitor, 3=No stress
-get_field_priority_level <- function(cv, morans_i) {
- # Handle NA values
- if (is.na(cv) || is.na(morans_i)) return(3) # Default to no stress
-
- # Determine priority based on thresholds
- if (cv < 0.1) {
- if (morans_i < 0.7) {
- return(3) # No stress
- } else if (morans_i <= 0.9) {
- return(2) # Monitor (young field with some clustering)
- } else {
- return(1) # Urgent
- }
- } else if (cv <= 0.15) {
- if (morans_i < 0.7) {
- return(2) # Monitor
- } else {
- return(1) # Urgent
- }
- } else { # cv > 0.15
- return(1) # Urgent
- }
-}
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
@@ -203,111 +178,6 @@ if (kpi_files_exist) {
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
-
-#' Generate field-specific KPI summary for display in reports
-#' @param field_name Name of the field to summarize
-#' @param field_details_table Data frame with field-level KPI details
-#' @return Formatted text string with field KPI summary
-generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant) {
- tryCatch({
- # Get field age from CI quadrant data for the CURRENT SEASON only
- # First identify the current season for this field
- current_season <- CI_quadrant %>%
- filter(field == field_name, Date <= as.Date(report_date)) %>%
- group_by(season) %>%
- summarise(season_end = max(Date), .groups = 'drop') %>%
- filter(season == max(season)) %>%
- pull(season)
-
- # Get the most recent DOY from the current season
- field_age <- CI_quadrant %>%
- filter(field == field_name, season == current_season) %>%
- pull(DOY) %>%
- max(na.rm = TRUE)
-
- # Filter data for this specific field
- field_data <- field_details_table %>%
- filter(Field == field_name)
-
- if (nrow(field_data) == 0) {
- return(paste("**Field", field_name, "KPIs:** Data not available"))
- }
-
- # Aggregate sub-field data for field-level summary
- # For categorical data, take the most common value or highest risk level
- field_summary <- field_data %>%
- summarise(
- field_size = sum(`Field Size (ha)`, na.rm = TRUE),
- uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
- avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)),
- max_gap_score = max(`Gap Score`, na.rm = TRUE),
- highest_decline_risk = case_when(
- any(`Decline Risk` == "Very-high") ~ "Very-high",
- any(`Decline Risk` == "High") ~ "High",
- any(`Decline Risk` == "Moderate") ~ "Moderate",
- any(`Decline Risk` == "Low") ~ "Low",
- TRUE ~ "Unknown"
- ),
- highest_weed_risk = case_when(
- any(`Weed Risk` == "High") ~ "High",
- any(`Weed Risk` == "Moderate") ~ "Moderate",
- any(`Weed Risk` == "Low") ~ "Low",
- TRUE ~ "Unknown"
- ),
- avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
- avg_cv = mean(`CV Value`, na.rm = TRUE),
- .groups = 'drop'
- )
-
- # Apply age-based filtering to yield forecast
- if (is.na(field_age) || field_age < 240) {
- field_summary$avg_yield_forecast <- NA_real_
- }
-
- # Format the summary text
- yield_text <- if (is.na(field_summary$avg_yield_forecast)) {
- "Yield Forecast: NA"
- } else {
- paste0("Yield Forecast: ", round(field_summary$avg_yield_forecast, 1), " t/ha")
- }
-
- kpi_text <- paste0(
- "Size: ", round(field_summary$field_size, 1), " ha | Growth Uniformity: ", field_summary$uniformity_levels,
- " | ", yield_text, " | Gap Score: ", round(field_summary$max_gap_score, 1),
- " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk,
- " | Mean CI: ", round(field_summary$avg_mean_ci, 2)
- )
-
- # Wrap in smaller text HTML tags for Word output
- #kpi_text <- paste0("", kpi_text, "")
- kpi_text <- paste0("", kpi_text, "")
-
- # Add alerts based on risk levels (smaller font too)
- # alerts <- c()
- # if (field_summary$highest_decline_risk %in% c("High", "Very-high")) {
- # alerts <- c(alerts, "🚨 High risk of growth decline detected")
- # }
- # if (field_summary$highest_weed_risk == "High") {
- # alerts <- c(alerts, "⚠️ High weed presence detected")
- # }
- # if (field_summary$max_gap_score > 20) {
- # alerts <- c(alerts, "💡 Significant gaps detected - monitor closely")
- # }
- # if (field_summary$avg_cv > 0.25) {
- # alerts <- c(alerts, "⚠️ Poor field uniformity - check irrigation/fertility")
- # }
-
- # if (length(alerts) > 0) {
- # kpi_text <- paste0(kpi_text, "\n\n", paste(alerts, collapse = "\n"))
- # }
-
- return(kpi_text)
-
- }, error = function(e) {
- safe_log(paste("Error generating KPI summary for field", field_name, ":", e$message), "ERROR")
- return(paste("**Field", field_name, "KPIs:** Error generating summary"))
- })
-}
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
@@ -366,7 +236,7 @@ tryCatch({
# NOTE: Overview maps skipped for this report
# Individual field sections load their own per-field mosaics directly
```
-```
+
```{r compute_benchmarks_once, include=FALSE}
# Compute CI benchmarks once for the entire estate
@@ -593,7 +463,7 @@ if (!exists("CI_quadrant") || is.null(CI_quadrant)) {
}
safe_log("CI quadrant data verified for field-level analysis")
```
-```
+
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
# Load field boundaries from parameters
diff --git a/r_app/91_CI_report_with_kpis_Angata.Rmd b/r_app/91_CI_report_with_kpis_Angata.Rmd
index a6ca227..6d305d9 100644
--- a/r_app/91_CI_report_with_kpis_Angata.Rmd
+++ b/r_app/91_CI_report_with_kpis_Angata.Rmd
@@ -72,31 +72,6 @@ tryCatch({
})
})
-# Function to determine field priority level based on CV and Moran's I
-# Returns: 1=Urgent, 2=Monitor, 3=No stress
-get_field_priority_level <- function(cv, morans_i) {
- # Handle NA values
- if (is.na(cv) || is.na(morans_i)) return(3) # Default to no stress
-
- # Determine priority based on thresholds
- if (cv < 0.1) {
- if (morans_i < 0.7) {
- return(3) # No stress
- } else if (morans_i <= 0.9) {
- return(2) # Monitor (young field with some clustering)
- } else {
- return(1) # Urgent
- }
- } else if (cv <= 0.15) {
- if (morans_i < 0.7) {
- return(2) # Monitor
- } else {
- return(1) # Urgent
- }
- } else { # cv > 0.15
- return(1) # Urgent
- }
-}
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
@@ -327,111 +302,6 @@ if (!is.null(cloud_file) && file.exists(cloud_file)) {
}
```
-```{r generate_field_kpi_summary_function, include=FALSE, eval=TRUE}
-#' Generate field-specific KPI summary for display in reports
-#' @param field_name Name of the field to summarize
-#' @param field_details_table Data frame with field-level KPI details
-#' @return Formatted text string with field KPI summary
-generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant) {
- tryCatch({
- # Get field age from CI quadrant data for the CURRENT SEASON only
- # First identify the current season for this field
- current_season <- CI_quadrant %>%
- filter(field == field_name, Date <= as.Date(report_date)) %>%
- group_by(season) %>%
- summarise(season_end = max(Date), .groups = 'drop') %>%
- filter(season == max(season)) %>%
- pull(season)
-
- # Get the most recent DOY from the current season
- field_age <- CI_quadrant %>%
- filter(field == field_name, season == current_season) %>%
- pull(DOY) %>%
- max(na.rm = TRUE)
-
- # Filter data for this specific field
- field_data <- field_details_table %>%
- filter(Field == field_name)
-
- if (nrow(field_data) == 0) {
- return(paste("**Field", field_name, "KPIs:** Data not available"))
- }
-
- # Aggregate sub-field data for field-level summary
- # For categorical data, take the most common value or highest risk level
- field_summary <- field_data %>%
- summarise(
- field_size = sum(`Field Size (ha)`, na.rm = TRUE),
- uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
- avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)),
- max_gap_score = max(`Gap Score`, na.rm = TRUE),
- highest_decline_risk = case_when(
- any(`Decline Risk` == "Very-high") ~ "Very-high",
- any(`Decline Risk` == "High") ~ "High",
- any(`Decline Risk` == "Moderate") ~ "Moderate",
- any(`Decline Risk` == "Low") ~ "Low",
- TRUE ~ "Unknown"
- ),
- highest_weed_risk = case_when(
- any(`Weed Risk` == "High") ~ "High",
- any(`Weed Risk` == "Moderate") ~ "Moderate",
- any(`Weed Risk` == "Low") ~ "Low",
- TRUE ~ "Unknown"
- ),
- avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
- avg_cv = mean(`CV Value`, na.rm = TRUE),
- .groups = 'drop'
- )
-
- # Apply age-based filtering to yield forecast
- if (is.na(field_age) || field_age < 240) {
- field_summary$avg_yield_forecast <- NA_real_
- }
-
- # Format the summary text
- yield_text <- if (is.na(field_summary$avg_yield_forecast)) {
- "Yield Forecast: NA"
- } else {
- paste0("Yield Forecast: ", round(field_summary$avg_yield_forecast, 1), " t/ha")
- }
-
- kpi_text <- paste0(
- "Size: ", round(field_summary$field_size, 1), " ha | Growth Uniformity: ", field_summary$uniformity_levels,
- " | ", yield_text, " | Gap Score: ", round(field_summary$max_gap_score, 1),
- " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk,
- " | Mean CI: ", round(field_summary$avg_mean_ci, 2)
- )
-
- # Wrap in smaller text HTML tags for Word output
- #kpi_text <- paste0("", kpi_text, "")
- kpi_text <- paste0("", kpi_text, "")
-
- # Add alerts based on risk levels (smaller font too)
- # alerts <- c()
- # if (field_summary$highest_decline_risk %in% c("High", "Very-high")) {
- # alerts <- c(alerts, "🚨 High risk of growth decline detected")
- # }
- # if (field_summary$highest_weed_risk == "High") {
- # alerts <- c(alerts, "⚠️ High weed presence detected")
- # }
- # if (field_summary$max_gap_score > 20) {
- # alerts <- c(alerts, "💡 Significant gaps detected - monitor closely")
- # }
- # if (field_summary$avg_cv > 0.25) {
- # alerts <- c(alerts, "⚠️ Poor field uniformity - check irrigation/fertility")
- # }
-
- # if (length(alerts) > 0) {
- # kpi_text <- paste0(kpi_text, "\n\n", paste(alerts, collapse = "\n"))
- # }
-
- return(kpi_text)
-
- }, error = function(e) {
- safe_log(paste("Error generating KPI summary for field", field_name, ":", e$message), "ERROR")
- return(paste("**Field", field_name, "KPIs:** Error generating summary"))
- })
-}
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE, eval=TRUE}
@@ -744,25 +614,7 @@ tryCatch({
\newpage
## 1.2 Key Performance Indicators
-```{r combined_kpi_table, echo=TRUE}
-# Debug: check what variables exist
-cat("\n=== DEBUG: combined_kpi_table chunk ===\n")
-cat(paste("exists('summary_data'):", exists("summary_data"), "\n"))
-cat(paste("exists('kpi_files_exist'):", exists("kpi_files_exist"), "\n"))
-if (exists("kpi_files_exist")) {
- cat(paste("kpi_files_exist value:", kpi_files_exist, "\n"))
-}
-if (exists("summary_data")) {
- cat(paste("summary_data class:", class(summary_data), "\n"))
- if (is.list(summary_data)) {
- cat(paste("summary_data names:", paste(names(summary_data), collapse = ", "), "\n"))
- cat(paste("has field_analysis_summary:", "field_analysis_summary" %in% names(summary_data), "\n"))
- }
-} else {
- cat("summary_data DOES NOT EXIST in this chunk's environment!\n")
-}
-cat("\n")
-
+```{r combined_kpi_table, echo=FALSE, results='asis'}
# Create summary KPI table from field_analysis_summary data
# This shows: Phases, Triggers, Area Change, and Total Farm acreage
@@ -773,7 +625,6 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
# If field_analysis_summary is NULL or doesn't exist, create it from field_analysis_df
if (is.null(summary_data$field_analysis_summary) || !("field_analysis_summary" %in% names(summary_data)) ||
!is.data.frame(summary_data$field_analysis_summary)) {
- cat("\nNote: field_analysis_summary not in RDS, creating from field_analysis...\n")
# Create summary by aggregating by Status_Alert and Phase categories
# This groups fields by their phase and status to show distribution
@@ -793,15 +644,12 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
mutate(Category = Status_Alert) %>%
select(Category, Acreage)
}, error = function(e) {
- cat("Could not create trigger summary:", e$message, "\n")
data.frame(Category = character(), Acreage = numeric())
})
# Combine into summary
field_analysis_summary <- bind_rows(phase_summary, trigger_summary)
- cat(paste("Created summary with", nrow(field_analysis_summary), "category rows\n"))
-
} else {
# Use existing summary from RDS
field_analysis_summary <- summary_data$field_analysis_summary
@@ -1042,16 +890,20 @@ tryCatch({
tryCatch({
# Try to repair invalid geometries
- field_boundaries_sf_fixed <<- sf::st_make_valid(field_boundaries_sf)
- AllPivots0 <<- field_boundaries_sf_fixed %>%
- dplyr::filter(!is.na(field), !is.na(sub_field))
+ field_boundaries_sf_fixed <- sf::st_make_valid(field_boundaries_sf)
+ assign("field_boundaries_sf_fixed", field_boundaries_sf_fixed, envir = .GlobalEnv)
- AllPivots_merged <<- AllPivots0 %>%
+ AllPivots0 <- field_boundaries_sf_fixed %>%
+ dplyr::filter(!is.na(field), !is.na(sub_field))
+ assign("AllPivots0", AllPivots0, envir = .GlobalEnv)
+
+ AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>%
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
+ assign("AllPivots_merged", AllPivots_merged, envir = .GlobalEnv)
- field_boundaries_loaded <<- TRUE
+ assign("field_boundaries_loaded", TRUE, envir = .GlobalEnv)
safe_log("✓ Fixed invalid geometries and loaded field boundaries")
}, error = function(e2) {
safe_log(paste("⚠ Could not repair geometries:", e2$message), "WARNING")
diff --git a/r_app/old_scripts/kpi_utils.R b/r_app/old_scripts/kpi_utils.R
index b960d1f..552f6bc 100644
--- a/r_app/old_scripts/kpi_utils.R
+++ b/r_app/old_scripts/kpi_utils.R
@@ -464,10 +464,9 @@ calculate_tch_forecasted_kpi <- function(field_boundaries, harvesting_data, cumu
tryCatch({
# Check if tonnage_ha is empty
- if (all(is.na(harvesting_data$tonnage_ha))) {
+ if (is.null(harvesting_data) || !("tonnage_ha" %in% names(harvesting_data)) || all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, using placeholder yield prediction", "WARNING")
- return(create_fallback_result(field_boundaries))
- }
+ return(create_fallback_result(field_boundaries)) }
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
@@ -657,8 +656,14 @@ calculate_growth_decline_kpi <- function(current_ci, previous_ci, field_boundari
current_values <- c()
previous_values <- c()
}
- previous_values <- extract_ci_values(previous_ci, field_vect)
-
+ # Extract CI values for both weeks
+ if (!is.null(current_field_ci) && !is.null(previous_field_ci)) {
+ current_values <- extract_ci_values(current_field_ci, field_vect)
+ previous_values <- extract_ci_values(previous_field_ci, field_vect)
+ } else {
+ current_values <- c()
+ previous_values <- c()
+ }
# Clean values
valid_idx <- !is.na(current_values) & !is.na(previous_values) &
is.finite(current_values) & is.finite(previous_values)
@@ -775,7 +780,9 @@ calculate_weed_presence_kpi <- function(current_ci, previous_ci, field_boundarie
rapid_growth_pct = numeric(0),
rapid_growth_pixels = numeric(0)
)
- return(list(summary = summary_result, field_results = field_results))
+ return(list(summary = summary_result, field_results = field_results))
+ }
+
# Handle both sf and SpatVector inputs
if (!inherits(field_boundaries, "SpatVector")) {
field_boundaries_vect <- terra::vect(field_boundaries)
@@ -1302,10 +1309,6 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
project_dir) {
safe_log("=== STARTING KPI CALCULATION ===")
safe_log(paste("Report date:", report_date))
-
- # Calculate week numbers
- weeks <- calculate_week_numbers(report_date)
- weeks <- calculate_week_numbers(report_date)
weeks <- calculate_week_numbers(report_date)
safe_log(paste("Current week:", weeks$current_week, "Previous week:", weeks$previous_week))
@@ -1314,7 +1317,11 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
previous_ci <- load_weekly_ci_mosaic(weeks$previous_week, weeks$previous_iso_year, weekly_CI_mosaic)
if (is.null(current_ci)) {
- stop("Current week CI mosaic is required but not found") stop("Field boundaries not loaded. Check parameters_project.R initialization.")
+ stop("Current week CI mosaic is required but not found")
+ }
+
+ if (is.null(field_boundaries_sf)) {
+ stop("Field boundaries not loaded. Check parameters_project.R initialization.")
}
# Calculate all KPIs
@@ -1353,8 +1360,6 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
kpi_results$gap_filling_field_results <- gap_filling_result$field_results
# Add metadata and field boundaries for later use
- kpi_results$metadata <- list(
- report_date = report_date,
kpi_results$metadata <- list(
report_date = report_date,
current_week = weeks$current_week,
@@ -1362,7 +1367,9 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
year = weeks$current_iso_year,
calculation_time = Sys.time(),
total_fields = nrow(field_boundaries_sf)
- ) kpi_results$field_boundaries_sf <- field_boundaries_sf
+ )
+
+ kpi_results$field_boundaries_sf <- field_boundaries_sf
# Save results if output directory specified
if (!is.null(output_dir)) {
diff --git a/r_app/report_utils.R b/r_app/report_utils.R
index 15b0c95..cc1a9aa 100644
--- a/r_app/report_utils.R
+++ b/r_app/report_utils.R
@@ -944,4 +944,129 @@ get_per_field_mosaic_path <- function(
}
}
+#' Determine field priority level based on CV and Moran's I
+#'
+#' @param cv Coefficient of Variation (uniformity metric)
+#' @param morans_i Moran's I spatial autocorrelation index
+#' @return Priority level: 1=Urgent, 2=Monitor, 3=No stress
+#'
+get_field_priority_level <- function(cv, morans_i) {
+ # Handle NA values
+ if (is.na(cv) || is.na(morans_i)) return(3) # Default to no stress
+
+ # Determine priority based on thresholds
+ if (cv < 0.1) {
+ if (morans_i < 0.7) {
+ return(3) # No stress
+ } else if (morans_i <= 0.9) {
+ return(2) # Monitor (young field with some clustering)
+ } else {
+ return(1) # Urgent
+ }
+ } else if (cv <= 0.15) {
+ if (morans_i < 0.7) {
+ return(2) # Monitor
+ } else {
+ return(1) # Urgent
+ }
+ } else { # cv > 0.15
+ return(1) # Urgent
+ }
+}
+
+#' Generate field-specific KPI summary for display in reports
+#'
+#' @param field_name Name of the field to summarize
+#' @param field_details_table Data frame with field-level KPI details
+#' @param CI_quadrant Data frame containing CI quadrant data with Date, DOY, season columns
+#' @param report_date Report date (used for filtering current season data)
+#' @return Formatted text string with field KPI summary
+#'
+generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant, report_date = Sys.Date()) {
+ tryCatch({
+ # Get field age from CI quadrant data for the CURRENT SEASON only
+ # First identify the current season for this field
+ # Get field age from CI quadrant data for the CURRENT SEASON only
+ # First identify the current season for this field
+ current_season_data <- CI_quadrant %>%
+ filter(field == field_name, Date <= as.Date(report_date)) %>%
+ group_by(season) %>%
+ summarise(season_end = max(Date), .groups = 'drop') %>%
+ filter(season == max(season))
+
+ if (nrow(current_season_data) == 0) {
+ return(paste("**Field", field_name, "KPIs:** No CI data available for current season"))
+ }
+ current_season <- current_season_data %>% pull(season)
+
+ # Get the most recent DOY from the current season
+ field_age_data <- CI_quadrant %>%
+ filter(field == field_name, season == current_season) %>%
+ pull(DOY)
+
+ field_age <- if (length(field_age_data) > 0) max(field_age_data, na.rm = TRUE) else NA_real_
+ # Filter data for this specific field
+ field_data <- field_details_table %>%
+ filter(Field == field_name)
+
+ if (nrow(field_data) == 0) {
+ return(paste("**Field", field_name, "KPIs:** Data not available"))
+ }
+
+ # Aggregate sub-field data for field-level summary
+ # For categorical data, take the most common value or highest risk level
+ field_summary <- field_data %>%
+ summarise(
+ field_size = sum(`Field Size (ha)`, na.rm = TRUE),
+ uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
+ avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)),
+ max_gap_score = max(`Gap Score`, na.rm = TRUE),
+ highest_decline_risk = case_when(
+ any(`Decline Risk` == "Very-high") ~ "Very-high",
+ any(`Decline Risk` == "High") ~ "High",
+ any(`Decline Risk` == "Moderate") ~ "Moderate",
+ any(`Decline Risk` == "Low") ~ "Low",
+ TRUE ~ "Unknown"
+ ),
+ highest_weed_risk = case_when(
+ any(`Weed Risk` == "High") ~ "High",
+ any(`Weed Risk` == "Moderate") ~ "Moderate",
+ any(`Weed Risk` == "Low") ~ "Low",
+ TRUE ~ "Unknown"
+ ),
+ avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
+ avg_cv = mean(`CV Value`, na.rm = TRUE),
+ .groups = 'drop'
+ )
+
+ # Apply age-based filtering to yield forecast
+ if (is.na(field_age) || field_age < 240) {
+ field_summary$avg_yield_forecast <- NA_real_
+ }
+
+ # Format the summary text
+ yield_text <- if (is.na(field_summary$avg_yield_forecast)) {
+ "Yield Forecast: NA"
+ } else {
+ paste0("Yield Forecast: ", round(field_summary$avg_yield_forecast, 1), " t/ha")
+ }
+
+ kpi_text <- paste0(
+ "Size: ", round(field_summary$field_size, 1), " ha | Growth Uniformity: ", field_summary$uniformity_levels,
+ " | ", yield_text, " | Gap Score: ", round(field_summary$max_gap_score, 1),
+ " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk,
+ " | Mean CI: ", round(field_summary$avg_mean_ci, 2)
+ )
+
+ # Wrap in smaller text HTML tags for Word output
+ kpi_text <- paste0("", kpi_text, "")
+
+ return(kpi_text)
+
+ }, error = function(e) {
+ safe_log(paste("Error generating KPI summary for field", field_name, ":", e$message), "ERROR")
+ return(paste("**Field", field_name, "KPIs:** Error generating summary"))
+ })
+}
+