some messy updates to script 90, wil l need to do some cleaning tomorrow...
This commit is contained in:
parent
6f54ed263b
commit
dd83a9e27f
|
|
@ -29,8 +29,8 @@
|
|||
# - year: ISO year (numeric, default current year)
|
||||
#
|
||||
# CLIENT TYPES:
|
||||
# - cane_supply (ANGATA): Yes - uses 80_utils_cane_supply.R (placeholder)
|
||||
# - agronomic_support (AURA): Yes - uses 80_utils_agronomic_support.R (6 KPI funcs)
|
||||
# - cane_supply: Yes - uses 80_utils_cane_supply.R (placeholder)
|
||||
# - agronomic_support: Yes - uses 80_utils_agronomic_support.R (6 KPI funcs)
|
||||
#
|
||||
# DEPENDENCIES:
|
||||
# - Packages: terra, sf, tidyverse, lubridate, writexl, spdep
|
||||
|
|
@ -327,17 +327,17 @@ main <- function() {
|
|||
# ============================================
|
||||
|
||||
if (client_config$script_90_compatible && "kpi_summary_tables" %in% client_config$outputs) {
|
||||
# AURA WORKFLOW: Run 6 farm-level KPIs for Script 90 compatibility
|
||||
# WORKFLOW: Run 6 farm-level KPIs for Script 90 compatibility
|
||||
message("\n", strrep("=", 70))
|
||||
message("AURA WORKFLOW: CALCULATING 6 FARM-LEVEL KPIs (Script 90 compatible)")
|
||||
message("WORKFLOW: CALCULATING 6 FARM-LEVEL KPIs (Script 90 compatible)")
|
||||
message(strrep("=", 70))
|
||||
|
||||
# Prepare inputs for KPI calculation (already created by setup_project_directories)
|
||||
reports_dir_kpi <- setup$kpi_reports_dir
|
||||
cumulative_CI_vals_dir <- setup$cumulative_CI_vals_dir
|
||||
|
||||
# Load field boundaries for AURA workflow (use data_dir from setup)
|
||||
message("\nLoading field boundaries for AURA KPI calculation...")
|
||||
# Load field boundaries for workflow (use data_dir from setup)
|
||||
message("\nLoading field boundaries for KPI calculation...")
|
||||
tryCatch({
|
||||
boundaries_result <- load_field_boundaries(setup$data_dir)
|
||||
|
||||
|
|
@ -368,17 +368,18 @@ 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,
|
||||
previous_mosaic_dir = NULL,
|
||||
ci_rds_path = NULL,
|
||||
harvesting_data = harvesting_data,
|
||||
cumulative_CI_vals_dir = cumulative_CI_vals_dir,
|
||||
weekly_CI_mosaic = setup$weekly_mosaic_dir,
|
||||
reports_dir = reports_dir_kpi,
|
||||
output_dir = reports_dir_kpi,
|
||||
project_dir = project_dir
|
||||
)
|
||||
|
||||
cat("\n=== AURA KPI CALCULATION COMPLETE ===\n")
|
||||
cat("\n=== KPI CALCULATION COMPLETE ===\n")
|
||||
cat("Summary tables saved for Script 90 integration\n")
|
||||
cat("Output directory:", reports_dir_kpi, "\n\n")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
# 80_UTILS_AGRONOMIC_SUPPORT.R
|
||||
# ============================================================================
|
||||
# AURA-SPECIFIC KPI UTILITIES (SCRIPT 80 - CLIENT TYPE: agronomic_support)
|
||||
# SPECIFIC KPI UTILITIES (SCRIPT 80 - CLIENT TYPE: agronomic_support)
|
||||
#
|
||||
# Contains all 6 AURA KPI calculation functions and helpers:
|
||||
# Contains all 6 KPI calculation functions and helpers:
|
||||
# - Field uniformity KPI (CV-based, spatial autocorrelation)
|
||||
# - Area change KPI (week-over-week CI changes)
|
||||
# - TCH forecasted KPI (tonnage projections from harvest data)
|
||||
|
|
@ -67,7 +67,7 @@ prepare_predictions <- function(harvest_model, field_data, scenario = "optimisti
|
|||
}
|
||||
|
||||
# ============================================================================
|
||||
# AURA KPI CALCULATION FUNCTIONS (6 KPIS)
|
||||
# KPI CALCULATION FUNCTIONS (6 KPIS)
|
||||
# ============================================================================
|
||||
|
||||
#' KPI 1: Calculate field uniformity based on CV and spatial autocorrelation
|
||||
|
|
@ -77,10 +77,10 @@ prepare_predictions <- function(harvest_model, field_data, scenario = "optimisti
|
|||
#'
|
||||
#' @param ci_pixels_by_field List of CI pixel arrays for each field
|
||||
#' @param field_boundaries_sf SF object with field geometries
|
||||
#' @param ci_band Raster band with CI values
|
||||
#' @param ci_raster Raster object with CI values (for spatial autocorrelation)
|
||||
#'
|
||||
#' @return Data frame with field_idx, cv_value, morans_i, uniformity_score, interpretation
|
||||
calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_sf, ci_band = NULL) {
|
||||
calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_sf, ci_raster = NULL) {
|
||||
result <- data.frame(
|
||||
field_idx = integer(),
|
||||
cv_value = numeric(),
|
||||
|
|
@ -108,8 +108,8 @@ calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_
|
|||
cv_val <- calculate_cv(ci_pixels)
|
||||
|
||||
morans_i <- NA_real_
|
||||
if (!is.null(ci_band)) {
|
||||
morans_result <- calculate_spatial_autocorrelation(ci_pixels, field_boundaries_sf[field_idx, ])
|
||||
if (!is.null(ci_raster)) {
|
||||
morans_result <- calculate_spatial_autocorrelation(ci_raster, field_boundaries_sf[field_idx, ])
|
||||
if (is.list(morans_result)) {
|
||||
morans_i <- morans_result$morans_i
|
||||
} else {
|
||||
|
|
@ -356,7 +356,7 @@ calculate_weed_presence_kpi <- function(ci_pixels_by_field) {
|
|||
#' Calculate Gap Filling Score KPI (placeholder)
|
||||
#' @param ci_raster Current week CI raster
|
||||
#' @param field_boundaries Field boundaries
|
||||
#' @return List with summary data frame and field-level results data frame
|
||||
#' @return Data frame with field-level gap filling scores
|
||||
calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
||||
# Handle both sf and SpatVector inputs
|
||||
if (!inherits(field_boundaries, "SpatVector")) {
|
||||
|
|
@ -365,11 +365,15 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
|||
field_boundaries_vect <- field_boundaries
|
||||
}
|
||||
|
||||
field_results <- data.frame()
|
||||
field_results <- data.frame(
|
||||
field_idx = integer(),
|
||||
gap_filling_success = numeric(),
|
||||
na_percent_pre_interpolation = numeric(),
|
||||
mean_ci = numeric(),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
for (i in seq_len(nrow(field_boundaries))) {
|
||||
field_name <- if ("field" %in% names(field_boundaries)) field_boundaries$field[i] else NA_character_
|
||||
sub_field_name <- if ("sub_field" %in% names(field_boundaries)) field_boundaries$sub_field[i] else NA_character_
|
||||
field_vect <- field_boundaries_vect[i]
|
||||
|
||||
# Extract CI values using helper function
|
||||
|
|
@ -377,83 +381,157 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
|||
valid_values <- ci_values[!is.na(ci_values) & is.finite(ci_values)]
|
||||
|
||||
if (length(valid_values) > 1) {
|
||||
# Gap score using 2σ below median to detect outliers
|
||||
median_ci <- median(valid_values)
|
||||
sd_ci <- sd(valid_values)
|
||||
outlier_threshold <- median_ci - (2 * sd_ci)
|
||||
low_ci_pixels <- sum(valid_values < outlier_threshold)
|
||||
total_pixels <- length(valid_values)
|
||||
gap_score <- (low_ci_pixels / total_pixels) * 100
|
||||
|
||||
# Classify gap severity
|
||||
gap_level <- dplyr::case_when(
|
||||
gap_score < 10 ~ "Minimal",
|
||||
gap_score < 25 ~ "Moderate",
|
||||
TRUE ~ "Significant"
|
||||
)
|
||||
# Calculate % of valid (non-NA) values = gap filling success
|
||||
total_pixels <- length(ci_values)
|
||||
valid_pixels <- length(valid_values)
|
||||
gap_filling_success <- (valid_pixels / total_pixels) * 100
|
||||
na_percent <- ((total_pixels - valid_pixels) / total_pixels) * 100
|
||||
|
||||
field_results <- rbind(field_results, data.frame(
|
||||
field = field_name,
|
||||
sub_field = sub_field_name,
|
||||
gap_level = gap_level,
|
||||
gap_score = gap_score,
|
||||
mean_ci = mean(valid_values),
|
||||
outlier_threshold = outlier_threshold
|
||||
field_idx = i,
|
||||
gap_filling_success = round(gap_filling_success, 2),
|
||||
na_percent_pre_interpolation = round(na_percent, 2),
|
||||
mean_ci = round(mean(valid_values), 2),
|
||||
stringsAsFactors = FALSE
|
||||
))
|
||||
} else {
|
||||
# Not enough valid data, fill with NA row
|
||||
# Not enough valid data
|
||||
field_results <- rbind(field_results, data.frame(
|
||||
field = field_name,
|
||||
sub_field = sub_field_name,
|
||||
gap_level = NA_character_,
|
||||
gap_score = NA_real_,
|
||||
field_idx = i,
|
||||
gap_filling_success = NA_real_,
|
||||
na_percent_pre_interpolation = NA_real_,
|
||||
mean_ci = NA_real_,
|
||||
outlier_threshold = NA_real_
|
||||
stringsAsFactors = FALSE
|
||||
))
|
||||
}
|
||||
}
|
||||
|
||||
# Summarize results
|
||||
gap_summary <- field_results %>%
|
||||
dplyr::group_by(gap_level) %>%
|
||||
dplyr::summarise(field_count = n(), .groups = 'drop') %>%
|
||||
dplyr::mutate(percent = round((field_count / sum(field_count)) * 100, 1))
|
||||
|
||||
return(list(summary = gap_summary, field_results = field_results))
|
||||
return(field_results)
|
||||
}
|
||||
|
||||
# ============================================================================
|
||||
# KPI ORCHESTRATOR AND REPORTING
|
||||
# ============================================================================
|
||||
|
||||
#' Create summary tables for all 6 KPIs
|
||||
#' Create summary tables for all 6 KPIs (AGGREGATED farm-level summaries)
|
||||
#'
|
||||
#' @param all_kpis List containing results from all 6 KPI functions
|
||||
#' @param all_kpis List containing results from all 6 KPI functions (per-field data)
|
||||
#'
|
||||
#' @return List of summary data frames ready for reporting
|
||||
#' @return List of summary data frames ready for reporting (farm-level aggregates)
|
||||
create_summary_tables <- function(all_kpis) {
|
||||
|
||||
# ==========================================
|
||||
# 1. UNIFORMITY SUMMARY (count by interpretation)
|
||||
# ==========================================
|
||||
uniformity_summary <- all_kpis$uniformity %>%
|
||||
group_by(interpretation) %>%
|
||||
summarise(
|
||||
field_count = n(),
|
||||
avg_cv = mean(cv_value, na.rm = TRUE),
|
||||
avg_morans_i = mean(morans_i, na.rm = TRUE),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
rename(
|
||||
Status = interpretation,
|
||||
`Field Count` = field_count,
|
||||
`Avg CV` = avg_cv,
|
||||
`Avg Moran's I` = avg_morans_i
|
||||
)
|
||||
|
||||
# ==========================================
|
||||
# 2. AREA CHANGE SUMMARY (improving/stable/declining counts)
|
||||
# ==========================================
|
||||
area_change_summary <- all_kpis$area_change %>%
|
||||
group_by(interpretation) %>%
|
||||
summarise(
|
||||
field_count = n(),
|
||||
avg_ci_change = mean(mean_ci_pct_change, na.rm = TRUE),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
rename(
|
||||
Status = interpretation,
|
||||
`Field Count` = field_count,
|
||||
`Avg CI Change %` = avg_ci_change
|
||||
)
|
||||
|
||||
# ==========================================
|
||||
# 3. TCH FORECAST SUMMARY (yield statistics)
|
||||
# ==========================================
|
||||
tch_summary <- all_kpis$tch_forecasted %>%
|
||||
summarise(
|
||||
avg_tch = mean(tch_forecasted, na.rm = TRUE),
|
||||
min_tch = min(tch_forecasted, na.rm = TRUE),
|
||||
max_tch = max(tch_forecasted, na.rm = TRUE),
|
||||
avg_ci = mean(mean_ci, na.rm = TRUE),
|
||||
fields_with_data = sum(!is.na(tch_forecasted))
|
||||
) %>%
|
||||
rename(
|
||||
`Avg Forecast (t/ha)` = avg_tch,
|
||||
`Min (t/ha)` = min_tch,
|
||||
`Max (t/ha)` = max_tch,
|
||||
`Avg CI` = avg_ci,
|
||||
`Fields` = fields_with_data
|
||||
)
|
||||
|
||||
# ==========================================
|
||||
# 4. GROWTH DECLINE SUMMARY (trend interpretation)
|
||||
# ==========================================
|
||||
growth_summary <- all_kpis$growth_decline %>%
|
||||
group_by(trend_interpretation) %>%
|
||||
summarise(
|
||||
field_count = n(),
|
||||
avg_trend = mean(four_week_trend, na.rm = TRUE),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
rename(
|
||||
Trend = trend_interpretation,
|
||||
`Field Count` = field_count,
|
||||
`Avg 4-Week Trend` = avg_trend
|
||||
)
|
||||
|
||||
# ==========================================
|
||||
# 5. WEED PRESSURE SUMMARY (risk level counts)
|
||||
# ==========================================
|
||||
weed_summary <- all_kpis$weed_presence %>%
|
||||
group_by(weed_pressure_risk) %>%
|
||||
summarise(
|
||||
field_count = n(),
|
||||
avg_fragmentation = mean(fragmentation_index, na.rm = TRUE),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
rename(
|
||||
`Risk Level` = weed_pressure_risk,
|
||||
`Field Count` = field_count,
|
||||
`Avg Fragmentation` = avg_fragmentation
|
||||
)
|
||||
|
||||
# ==========================================
|
||||
# 6. GAP FILLING SUMMARY
|
||||
# ==========================================
|
||||
gap_summary <- if (!is.null(all_kpis$gap_filling) && is.data.frame(all_kpis$gap_filling) && nrow(all_kpis$gap_filling) > 0) {
|
||||
all_kpis$gap_filling %>%
|
||||
summarise(
|
||||
avg_gap_filling = mean(gap_filling_success, na.rm = TRUE),
|
||||
avg_na_percent = mean(na_percent_pre_interpolation, na.rm = TRUE),
|
||||
fields_with_data = n()
|
||||
) %>%
|
||||
rename(
|
||||
`Avg Gap Filling Success %` = avg_gap_filling,
|
||||
`Avg NA % Pre-Interpolation` = avg_na_percent,
|
||||
`Fields Analyzed` = fields_with_data
|
||||
)
|
||||
} else {
|
||||
data.frame(`Avg Gap Filling Success %` = NA_real_, `Avg NA % Pre-Interpolation` = NA_real_, `Fields Analyzed` = 0)
|
||||
}
|
||||
|
||||
# Return as list (each element is a farm-level summary table)
|
||||
kpi_summary <- list(
|
||||
uniformity = all_kpis$uniformity %>%
|
||||
select(field_idx, cv_value, morans_i, uniformity_score, interpretation),
|
||||
|
||||
area_change = all_kpis$area_change %>%
|
||||
select(field_idx, mean_ci_pct_change, interpretation),
|
||||
|
||||
tch_forecast = all_kpis$tch_forecasted %>%
|
||||
select(field_idx, mean_ci, tch_forecasted, tch_lower_bound, tch_upper_bound, confidence),
|
||||
|
||||
growth_decline = all_kpis$growth_decline %>%
|
||||
select(field_idx, four_week_trend, trend_interpretation, decline_severity),
|
||||
|
||||
weed_pressure = all_kpis$weed_presence %>%
|
||||
select(field_idx, fragmentation_index, weed_pressure_risk),
|
||||
|
||||
gap_filling = if (!is.null(all_kpis$gap_filling)) {
|
||||
all_kpis$gap_filling %>%
|
||||
select(field_idx, na_percent_pre_interpolation, gap_filling_success)
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
uniformity = uniformity_summary,
|
||||
area_change = area_change_summary,
|
||||
tch_forecast = tch_summary,
|
||||
growth_decline = growth_summary,
|
||||
weed_pressure = weed_summary,
|
||||
gap_filling = gap_summary
|
||||
)
|
||||
|
||||
return(kpi_summary)
|
||||
|
|
@ -465,7 +543,7 @@ create_summary_tables <- function(all_kpis) {
|
|||
#' @param all_kpis List with all KPI results
|
||||
#' @param field_boundaries_sf SF object with field boundaries
|
||||
#'
|
||||
#' @return Data frame with one row per field, all KPI columns
|
||||
#' @return Data frame with one row per field, all KPI columns (renamed for reporting compatibility)
|
||||
create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
|
||||
result <- field_df %>%
|
||||
left_join(
|
||||
|
|
@ -487,7 +565,24 @@ create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
|
|||
left_join(
|
||||
all_kpis$weed_presence %>% select(field_idx, weed_pressure_risk),
|
||||
by = c("field_idx")
|
||||
)
|
||||
) %>%
|
||||
# Rename columns to match reporting script expectations
|
||||
rename(
|
||||
Field = field_name,
|
||||
`Growth Uniformity` = uniformity_interpretation,
|
||||
`Yield Forecast (t/ha)` = tch_forecasted,
|
||||
`Decline Risk` = decline_severity,
|
||||
`Weed Risk` = weed_pressure_risk,
|
||||
`Mean CI` = mean_ci_pct_change,
|
||||
`CV Value` = cv_value
|
||||
) %>%
|
||||
# Add placeholder columns expected by reporting script (will be populated from other sources)
|
||||
mutate(
|
||||
`Field Size (ha)` = NA_real_,
|
||||
`Gap Score` = NA_real_
|
||||
) %>%
|
||||
select(field_idx, Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`,
|
||||
`Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`)
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
|
@ -499,7 +594,7 @@ create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
|
|||
#' @return Character string with formatted KPI summary text
|
||||
create_field_kpi_text <- function(all_kpis) {
|
||||
text_parts <- c(
|
||||
"## AURA KPI ANALYSIS SUMMARY\n",
|
||||
"## KPI ANALYSIS SUMMARY\n",
|
||||
"### Field Uniformity\n",
|
||||
paste(all_kpis$uniformity$interpretation, collapse = "; "), "\n",
|
||||
"### Growth Trends\n",
|
||||
|
|
@ -513,21 +608,47 @@ create_field_kpi_text <- function(all_kpis) {
|
|||
|
||||
#' Export detailed KPI data to Excel/RDS
|
||||
#'
|
||||
#' @param all_kpis List with all KPI results
|
||||
#' @param kpi_summary List with summary tables
|
||||
#' @param all_kpis List with all KPI results (per-field data)
|
||||
#' @param kpi_summary List with summary tables (farm-level aggregates)
|
||||
#' @param project_dir Project name (for filename)
|
||||
#' @param output_dir Directory for output files
|
||||
#' @param week Week number
|
||||
#' @param year Year
|
||||
#' @param field_boundaries_sf SF object with field boundaries (optional, for field_details_table)
|
||||
#'
|
||||
#' @return List of output file paths
|
||||
export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year) {
|
||||
export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week, year, field_boundaries_sf = NULL) {
|
||||
# Ensure output directory exists
|
||||
if (!dir.exists(output_dir)) {
|
||||
dir.create(output_dir, recursive = TRUE)
|
||||
}
|
||||
|
||||
# Export all KPI tables to a single Excel file
|
||||
excel_file <- paste0(output_dir, "/AURA_KPI_week_", sprintf("%02d_%d", week, year), ".xlsx")
|
||||
# Create unified field details table if field_boundaries_sf is provided
|
||||
field_details_table <- NULL
|
||||
if (!is.null(field_boundaries_sf)) {
|
||||
tryCatch({
|
||||
# Create a basic field_df from the boundaries
|
||||
field_df <- data.frame(
|
||||
field_idx = 1:nrow(field_boundaries_sf),
|
||||
field_name = if (!is.null(field_boundaries_sf$properties$name)) {
|
||||
field_boundaries_sf$properties$name
|
||||
} else if (!is.null(field_boundaries_sf$name)) {
|
||||
field_boundaries_sf$name
|
||||
} else {
|
||||
paste0("Field_", 1:nrow(field_boundaries_sf))
|
||||
},
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
field_details_table <- create_field_detail_table(field_df, all_kpis, field_boundaries_sf)
|
||||
message(paste("✓ Field details table created with", nrow(field_details_table), "fields"))
|
||||
}, error = function(e) {
|
||||
message(paste("WARNING: Could not create field_details_table:", e$message))
|
||||
})
|
||||
}
|
||||
|
||||
# Export all KPI tables to a single Excel file - use project_dir"
|
||||
excel_file <- file.path(output_dir, paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".xlsx"))
|
||||
|
||||
sheets <- list(
|
||||
"Uniformity" = as.data.frame(kpi_summary$uniformity),
|
||||
|
|
@ -539,12 +660,23 @@ export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year) {
|
|||
)
|
||||
|
||||
write_xlsx(sheets, excel_file)
|
||||
message(paste("✓ AURA KPI data exported to:", excel_file))
|
||||
message(paste("✓ KPI data exported to:", excel_file))
|
||||
|
||||
# Also export to RDS for programmatic access
|
||||
rds_file <- paste0(output_dir, "/AURA_KPI_week_", sprintf("%02d_%d", week, year), ".rds")
|
||||
saveRDS(all_kpis, rds_file)
|
||||
message(paste("✓ AURA KPI RDS exported to:", rds_file))
|
||||
# Export to RDS for programmatic access (CRITICAL: Both per-field AND summary tables)
|
||||
# The reporting script expects: summary_tables (list of 6 summary tables)
|
||||
# We also provide: all_kpis (per-field data) and field_details (unified field view)
|
||||
rds_file <- file.path(output_dir, paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".rds"))
|
||||
|
||||
# Create the export structure that reporting scripts expect
|
||||
export_data <- list(
|
||||
summary_tables = kpi_summary, # Farm-level aggregates (6 KPI summaries)
|
||||
all_kpis = all_kpis, # Per-field data (6 KPI per-field tables)
|
||||
field_details = field_details_table # Unified field-level detail table
|
||||
)
|
||||
|
||||
saveRDS(export_data, rds_file)
|
||||
message(paste("✓ KPI RDS exported to:", rds_file))
|
||||
message(" Structure: list($summary_tables, $all_kpis, $field_details)")
|
||||
|
||||
return(list(excel = excel_file, rds = rds_file))
|
||||
}
|
||||
|
|
@ -553,9 +685,9 @@ export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year) {
|
|||
# ORCHESTRATOR FUNCTION
|
||||
# ============================================================================
|
||||
|
||||
#' Calculate all 6 AURA KPIs
|
||||
#' Calculate all 6 KPIs
|
||||
#'
|
||||
#' Main entry point for AURA KPI calculation.
|
||||
#' Main entry point for KPI calculation.
|
||||
#' This function orchestrates the 6 KPI calculations and returns all results.
|
||||
#'
|
||||
#' @param field_boundaries_sf SF object with field geometries
|
||||
|
|
@ -566,6 +698,7 @@ export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year) {
|
|||
#' @param ci_rds_path Path to combined CI RDS file
|
||||
#' @param harvesting_data Data frame with harvest data (optional)
|
||||
#' @param output_dir Directory for KPI exports
|
||||
#' @param project_dir Project name (for filename in exports)
|
||||
#'
|
||||
#' @return List with results from all 6 KPI functions
|
||||
#'
|
||||
|
|
@ -573,7 +706,7 @@ export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year) {
|
|||
#' This function:
|
||||
#' 1. Loads current week mosaic and extracts field statistics
|
||||
#' 2. (Optionally) loads previous week mosaic for comparison metrics
|
||||
#' 3. Calculates all 6 AURA KPIs
|
||||
#' 3. Calculates all 6 KPIs
|
||||
#' 4. Creates summary tables
|
||||
#' 5. Exports results to Excel/RDS
|
||||
#'
|
||||
|
|
@ -585,10 +718,11 @@ calculate_all_kpis <- function(
|
|||
previous_mosaic_dir = NULL,
|
||||
ci_rds_path = NULL,
|
||||
harvesting_data = NULL,
|
||||
output_dir = NULL
|
||||
output_dir = NULL,
|
||||
project_dir = NULL
|
||||
) {
|
||||
|
||||
message("\n============ AURA KPI CALCULATION (6 KPIs) ============")
|
||||
message("\n============ KPI CALCULATION (6 KPIs) ============")
|
||||
|
||||
# Load current week mosaic
|
||||
message("Loading current week mosaic...")
|
||||
|
|
@ -644,7 +778,7 @@ calculate_all_kpis <- function(
|
|||
weed_kpi <- calculate_weed_presence_kpi(ci_pixels_by_field)
|
||||
|
||||
message("Calculating KPI 6: Gap Filling...")
|
||||
gap_filling_kpi <- calculate_gap_filling_kpi(ci_rds_path)
|
||||
gap_filling_kpi <- calculate_gap_filling_kpi(current_mosaic, field_boundaries_sf)
|
||||
|
||||
# Compile results
|
||||
all_kpis <- list(
|
||||
|
|
@ -659,10 +793,18 @@ calculate_all_kpis <- function(
|
|||
# Create summary tables
|
||||
kpi_summary <- create_summary_tables(all_kpis)
|
||||
|
||||
# Export
|
||||
export_paths <- export_kpi_data(all_kpis, kpi_summary, output_dir, current_week, current_year)
|
||||
# Export - pass project_dir for proper filename and field_boundaries_sf for field details table
|
||||
if (is.null(project_dir)) {
|
||||
project_dir <- "AURA" # Fallback if not provided
|
||||
}
|
||||
export_paths <- export_kpi_data(all_kpis, kpi_summary, project_dir, output_dir, current_week, current_year, field_boundaries_sf)
|
||||
|
||||
message(paste("\n✓ AURA KPI calculation complete. Week", current_week, current_year, "\n"))
|
||||
message(paste("\n✓", project_dir, "KPI calculation complete. Week", current_week, current_year, "\n"))
|
||||
|
||||
return(all_kpis)
|
||||
# Return combined structure (for integration with 80_calculate_kpis.R)
|
||||
return(list(
|
||||
all_kpis = all_kpis,
|
||||
summary_tables = kpi_summary,
|
||||
field_details = NULL # Will be populated if export_kpi_data succeeds
|
||||
))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,15 +1,15 @@
|
|||
---
|
||||
params:
|
||||
ref: "word-styles-reference-var1.docx"
|
||||
output_file: CI_report.docx
|
||||
report_date: "2026-01-22"
|
||||
output_file: "CI_report.docx"
|
||||
report_date: !r Sys.Date()
|
||||
data_dir: "angata"
|
||||
mail_day: "Wednesday"
|
||||
borders: FALSE
|
||||
ci_plot_type: "both" # options: "absolute", "cumulative", "both"
|
||||
colorblind_friendly: TRUE # use colorblind-friendly palettes (viridis/plasma)
|
||||
facet_by_season: FALSE # facet CI trend plots by season instead of overlaying
|
||||
x_axis_unit: "days" # x-axis unit for trend plots: "days" or "weeks"
|
||||
ci_plot_type: "both"
|
||||
colorblind_friendly: TRUE
|
||||
facet_by_season: FALSE
|
||||
x_axis_unit: "days"
|
||||
output:
|
||||
word_document:
|
||||
reference_docx: !expr file.path("word-styles-reference-var1.docx")
|
||||
|
|
@ -90,93 +90,87 @@ tryCatch({
|
|||
# Load centralized paths
|
||||
paths <- setup_project_directories(project_dir)
|
||||
|
||||
# Assign global variables for use in visualization functions
|
||||
weekly_CI_mosaic <- paths$weekly_mosaic_dir # Per-field mosaic directory
|
||||
|
||||
# Log initial configuration
|
||||
safe_log("Starting the R Markdown script with KPIs")
|
||||
safe_log(paste("mail_day params:", params$mail_day))
|
||||
safe_log(paste("report_date params:", params$report_date))
|
||||
safe_log(paste("mail_day variable:", mail_day))
|
||||
safe_log(paste("weekly_CI_mosaic path:", weekly_CI_mosaic))
|
||||
```
|
||||
|
||||
```{r load_kpi_data, message=FALSE, warning=FALSE, include=FALSE}
|
||||
## SIMPLE KPI LOADING - robust lookup with fallbacks
|
||||
# Primary expected directory from centralized paths
|
||||
kpi_data_dir <- paths$kpi_reports_dir
|
||||
date_suffix <- format(as.Date(report_date), "%Y%m%d")
|
||||
## LOAD KPI DATA - DYNAMIC PROJECT-SPECIFIC loading
|
||||
# NO workspace-wide fallback that might load wrong project
|
||||
|
||||
# Calculate current week from report_date using ISO 8601 week numbering
|
||||
# Build expected KPI file path strictly from project_dir
|
||||
kpi_data_dir <- paths$kpi_reports_dir # Should be: laravel_app/storage/app/{project}/reports/kpis/field_level
|
||||
|
||||
# Calculate week from report_date
|
||||
current_week <- as.numeric(format(as.Date(report_date), "%V"))
|
||||
current_year <- as.numeric(format(as.Date(report_date), "%G"))
|
||||
week_suffix <- paste0("week", sprintf("%02d", current_week), "_", current_year)
|
||||
|
||||
# Candidate filenames we expect (exact and common variants)
|
||||
expected_summary_names <- c(
|
||||
paste0(project_dir, "_kpi_summary_tables_", week_suffix, ".rds"),
|
||||
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
|
||||
paste0(project_dir, "_kpi_summary_tables.rds"),
|
||||
"kpi_summary_tables.rds",
|
||||
paste0("kpi_summary_tables_", week_suffix, ".rds"),
|
||||
paste0("kpi_summary_tables_", date_suffix, ".rds")
|
||||
)
|
||||
# The ACTUAL filename format from 80_calculate_kpis.R output (after fix)
|
||||
# Format: {project_dir}_kpi_summary_tables_week{WW}_{YYYY}.rds
|
||||
kpi_rds_filename <- paste0(project_dir, "_kpi_summary_tables_week",
|
||||
sprintf("%02d_%d", current_week, current_year), ".rds")
|
||||
kpi_rds_path <- file.path(kpi_data_dir, kpi_rds_filename)
|
||||
|
||||
expected_field_details_names <- c(
|
||||
paste0(project_dir, "_field_details_", week_suffix, ".rds"),
|
||||
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
|
||||
paste0(project_dir, "_field_details.rds"),
|
||||
"field_details.rds"
|
||||
)
|
||||
safe_log(paste("Looking for KPI file:", kpi_rds_path))
|
||||
safe_log(paste("Project directory:", project_dir))
|
||||
safe_log(paste("Expected filename:", kpi_rds_filename))
|
||||
|
||||
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
|
||||
try_load_from_dir <- function(dir, candidates) {
|
||||
if (!dir.exists(dir)) return(NULL)
|
||||
for (name in candidates) {
|
||||
f <- file.path(dir, name)
|
||||
if (file.exists(f)) return(f)
|
||||
}
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
# Try primary directory first
|
||||
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
|
||||
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
|
||||
|
||||
# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
|
||||
if (is.null(summary_file) || is.null(field_details_file)) {
|
||||
safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
|
||||
# List rds files under laravel_app/storage/app recursively
|
||||
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
|
||||
# Try to match by expected names
|
||||
if (is.null(summary_file)) {
|
||||
matched <- files[basename(files) %in% expected_summary_names]
|
||||
if (length(matched) > 0) summary_file <- matched[1]
|
||||
}
|
||||
if (is.null(field_details_file)) {
|
||||
matched2 <- files[basename(files) %in% expected_field_details_names]
|
||||
if (length(matched2) > 0) field_details_file <- matched2[1]
|
||||
}
|
||||
}
|
||||
|
||||
# Final checks and load with safe error messages
|
||||
# Load with strict error checking - NO fallback to find other project's files
|
||||
kpi_files_exist <- FALSE
|
||||
if (!is.null(summary_file) && file.exists(summary_file)) {
|
||||
safe_log(paste("Loading KPI summary from:", summary_file))
|
||||
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
|
||||
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
|
||||
summary_tables <- NULL
|
||||
field_details_table <- NULL
|
||||
|
||||
if (dir.exists(kpi_data_dir)) {
|
||||
if (file.exists(kpi_rds_path)) {
|
||||
safe_log(paste("✓ Found KPI file for", project_dir))
|
||||
loaded_data <- tryCatch(
|
||||
readRDS(kpi_rds_path),
|
||||
error = function(e) {
|
||||
safe_log(paste("ERROR reading KPI RDS:", e$message), "ERROR")
|
||||
return(NULL)
|
||||
}
|
||||
)
|
||||
|
||||
# Handle new RDS structure (list with $summary_tables, $all_kpis, $field_details)
|
||||
if (!is.null(loaded_data)) {
|
||||
if (is.list(loaded_data) && "summary_tables" %in% names(loaded_data)) {
|
||||
# New structure: extract summary_tables from the list
|
||||
summary_tables <- loaded_data$summary_tables
|
||||
if (!is.null(loaded_data$field_details)) {
|
||||
field_details_table <- loaded_data$field_details
|
||||
}
|
||||
safe_log("✓ Loaded KPI data (new structure with summary_tables)")
|
||||
kpi_files_exist <- TRUE
|
||||
} else if (is.list(loaded_data) && length(loaded_data) > 0) {
|
||||
# Legacy structure: directly use as summary_tables
|
||||
summary_tables <- loaded_data
|
||||
safe_log("✓ Loaded KPI tables (legacy structure)")
|
||||
kpi_files_exist <- TRUE
|
||||
}
|
||||
|
||||
if (kpi_files_exist) {
|
||||
safe_log(paste("✓ Available KPI tables:", paste(names(summary_tables), collapse=", ")))
|
||||
}
|
||||
}
|
||||
} else {
|
||||
safe_log(paste("KPI file not found in:", kpi_rds_path), "WARNING")
|
||||
safe_log(paste("Expected file:", kpi_rds_filename), "WARNING")
|
||||
safe_log(paste("Files in directory:", paste(list.files(kpi_data_dir, pattern="\\.rds$"), collapse=", ")), "WARNING")
|
||||
}
|
||||
} else {
|
||||
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
|
||||
safe_log(paste("KPI directory does not exist:", kpi_data_dir), "WARNING")
|
||||
}
|
||||
|
||||
if (!is.null(field_details_file) && file.exists(field_details_file)) {
|
||||
safe_log(paste("Loading field details from:", field_details_file))
|
||||
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
|
||||
if (!is.null(field_details_table)) kpi_files_exist <- TRUE
|
||||
} else {
|
||||
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
|
||||
}
|
||||
|
||||
if (kpi_files_exist) {
|
||||
safe_log("✓ KPI summary tables loaded successfully")
|
||||
} else {
|
||||
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
|
||||
if (!kpi_files_exist) {
|
||||
safe_log(paste("Skipping KPI sections - no data for", project_dir, "on", report_date), "WARNING")
|
||||
summary_tables <- NULL
|
||||
}
|
||||
```
|
||||
|
||||
|
|
@ -227,10 +221,32 @@ safe_log(paste("Week range:", week_start, "to", week_end))
|
|||
```{r load_ci_data, message=FALSE, warning=FALSE, include=FALSE}
|
||||
# Load CI quadrant data for field-level analysis
|
||||
tryCatch({
|
||||
CI_quadrant <- readRDS(here::here(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
|
||||
safe_log("Successfully loaded CI quadrant data")
|
||||
# Try multiple path constructions to handle different directory structures (dynamically)
|
||||
candidate_paths <- c(
|
||||
file.path(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"),
|
||||
here::here(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"),
|
||||
file.path("laravel_app/storage/app", project_dir, "Data/extracted_ci/cumulative_vals/All_pivots_Cumulative_CI_quadrant_year_v2.rds")
|
||||
)
|
||||
|
||||
# Find first valid path
|
||||
ci_quadrant_path <- NULL
|
||||
for (path in candidate_paths) {
|
||||
if (file.exists(path)) {
|
||||
ci_quadrant_path <- path
|
||||
break
|
||||
}
|
||||
}
|
||||
|
||||
if (is.null(ci_quadrant_path)) {
|
||||
safe_log(paste("CI quadrant file not found. Tried:", paste(candidate_paths, collapse=", ")), "WARNING")
|
||||
CI_quadrant <- NULL
|
||||
} else {
|
||||
CI_quadrant <- readRDS(ci_quadrant_path)
|
||||
safe_log(paste("Successfully loaded CI quadrant data from:", ci_quadrant_path))
|
||||
}
|
||||
}, error = function(e) {
|
||||
stop("Error loading CI quadrant data: ", e$message)
|
||||
safe_log(paste("Error loading CI quadrant data:", e$message), "WARNING")
|
||||
CI_quadrant <<- NULL
|
||||
})
|
||||
|
||||
# NOTE: Overview maps skipped for this report
|
||||
|
|
@ -254,11 +270,22 @@ tryCatch({
|
|||
|
||||
```{r compute_benchmarks_once, include=FALSE}
|
||||
# Compute CI benchmarks once for the entire estate
|
||||
benchmarks <- compute_ci_benchmarks(CI_quadrant, project_dir, c(10, 50, 90))
|
||||
if (!is.null(benchmarks)) {
|
||||
safe_log("Benchmarks computed successfully for the report")
|
||||
if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) {
|
||||
tryCatch({
|
||||
benchmarks <- compute_ci_benchmarks(CI_quadrant, project_dir, c(10, 50, 90))
|
||||
if (!is.null(benchmarks)) {
|
||||
safe_log("Benchmarks computed successfully for the report")
|
||||
} else {
|
||||
safe_log("Failed to compute benchmarks", "WARNING")
|
||||
benchmarks <- NULL
|
||||
}
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error computing benchmarks:", e$message), "WARNING")
|
||||
benchmarks <<- NULL
|
||||
})
|
||||
} else {
|
||||
safe_log("Failed to compute benchmarks", "WARNING")
|
||||
safe_log("Skipping benchmark computation - CI quadrant data not available", "WARNING")
|
||||
benchmarks <- NULL
|
||||
}
|
||||
```
|
||||
|
||||
|
|
@ -279,28 +306,68 @@ if (!is.null(benchmarks)) {
|
|||
## Key Insights
|
||||
|
||||
```{r key_insights, echo=FALSE, results='asis'}
|
||||
# Calculate key insights from KPI data
|
||||
if (exists("summary_tables") && !is.null(summary_tables)) {
|
||||
# Calculate key insights from aggregated KPI summary data
|
||||
if (exists("summary_tables") && !is.null(summary_tables) && length(summary_tables) > 0) {
|
||||
|
||||
# Field uniformity insights
|
||||
uniformity_data <- summary_tables$field_uniformity_summary
|
||||
good_uniformity <- uniformity_data$Percent[uniformity_data$`Uniformity Level` == "Good"]
|
||||
excellent_uniformity <- uniformity_data$Percent[uniformity_data$`Uniformity Level` == "Excellent"]
|
||||
# Extract aggregated KPI summaries (farm-level, not per-field)
|
||||
uniformity_summary <- summary_tables$uniformity # Has: Status, Field Count, Avg CV, Avg Moran's I
|
||||
area_change_summary <- summary_tables$area_change # Has: Status, Field Count, Avg CI Change %
|
||||
growth_summary <- summary_tables$growth_decline # Has: Trend, Field Count, Avg 4-Week Trend
|
||||
weed_summary <- summary_tables$weed_pressure # Has: Risk Level, Field Count, Avg Fragmentation
|
||||
|
||||
# Total fields analyzed (from uniformity summary)
|
||||
total_fields <- sum(uniformity_summary$`Field Count`, na.rm = TRUE)
|
||||
|
||||
# Uniformity insights
|
||||
if (!is.null(uniformity_summary) && nrow(uniformity_summary) > 0) {
|
||||
cat("**Field Uniformity:**\n")
|
||||
for (i in 1:nrow(uniformity_summary)) {
|
||||
status <- uniformity_summary$Status[i]
|
||||
count <- uniformity_summary$`Field Count`[i]
|
||||
if (count > 0) {
|
||||
cat("- ", count, " field(s) with ", status, "\n", sep="")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Area change insights
|
||||
area_change_data <- summary_tables$area_change_summary
|
||||
improving_area <- area_change_data$Hectares[area_change_data$`Change Type` == "Improving areas"]
|
||||
improving_pct <- area_change_data$Percent[area_change_data$`Change Type` == "Improving areas"]
|
||||
declining_area <- area_change_data$Hectares[area_change_data$`Change Type` == "Declining areas"]
|
||||
declining_pct <- area_change_data$Percent[area_change_data$`Change Type` == "Declining areas"]
|
||||
if (!is.null(area_change_summary) && nrow(area_change_summary) > 0) {
|
||||
cat("\n**Area Change Status:**\n")
|
||||
for (i in 1:nrow(area_change_summary)) {
|
||||
status <- area_change_summary$Status[i]
|
||||
count <- area_change_summary$`Field Count`[i]
|
||||
if (count > 0 && !is.na(status)) {
|
||||
cat("- ", count, " field(s) ", status, "\n", sep="")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cat("- ", ifelse(length(good_uniformity) > 0, good_uniformity, "N/A"), "% of fields have good uniformity\n", sep="")
|
||||
cat("- ", ifelse(length(excellent_uniformity) > 0, excellent_uniformity, "N/A"), "% of fields have excellent uniformity\n", sep="")
|
||||
cat("- ", ifelse(length(improving_area) > 0, round(improving_area, 1), "N/A"), " hectares (", ifelse(length(improving_pct) > 0, improving_pct, "N/A"), "%) of farm area is improving week-over-week\n", sep="")
|
||||
cat("- ", ifelse(length(declining_area) > 0, round(declining_area, 1), "N/A"), " hectares (", ifelse(length(declining_pct) > 0, declining_pct, "N/A"), "%) of farm area is declining week-over-week\n", sep="")
|
||||
# Growth trend insights
|
||||
if (!is.null(growth_summary) && nrow(growth_summary) > 0) {
|
||||
cat("\n**Growth Trends (4-Week):**\n")
|
||||
for (i in 1:nrow(growth_summary)) {
|
||||
trend <- growth_summary$Trend[i]
|
||||
count <- growth_summary$`Field Count`[i]
|
||||
if (count > 0 && !is.na(trend)) {
|
||||
cat("- ", count, " field(s) with ", trend, "\n", sep="")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Weed pressure insights
|
||||
if (!is.null(weed_summary) && nrow(weed_summary) > 0) {
|
||||
cat("\n**Weed/Pest Pressure Risk:**\n")
|
||||
for (i in 1:nrow(weed_summary)) {
|
||||
risk <- weed_summary$`Risk Level`[i]
|
||||
count <- weed_summary$`Field Count`[i]
|
||||
if (count > 0 && !is.na(risk)) {
|
||||
cat("- ", count, " field(s) at ", risk, " risk\n", sep="")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
} else {
|
||||
cat("KPI data not available for key insights.\n")
|
||||
cat("KPI data not available for ", project_dir, " on this date.\n", sep="")
|
||||
}
|
||||
```
|
||||
|
||||
|
|
@ -311,55 +378,48 @@ if (exists("summary_tables") && !is.null(summary_tables)) {
|
|||
## Executive Summary - Key Performance Indicators
|
||||
|
||||
```{r combined_kpi_table, echo=FALSE, results='asis'}
|
||||
# Combine all KPI tables into a single table with standardized column names
|
||||
display_names <- c(
|
||||
field_uniformity_summary = "Field Uniformity",
|
||||
area_change_summary = "Area Change",
|
||||
tch_forecasted_summary = "TCH Forecasted",
|
||||
growth_decline_summary = "Growth Decline",
|
||||
weed_presence_summary = "Weed Presence",
|
||||
gap_filling_summary = "Gap Filling"
|
||||
)
|
||||
|
||||
combined_df <- bind_rows(lapply(names(summary_tables), function(kpi) {
|
||||
df <- summary_tables[[kpi]]
|
||||
names(df) <- c("Level", "Count", "Percent")
|
||||
# Format Count as integer (no decimals)
|
||||
df <- df %>%
|
||||
mutate(
|
||||
Count = as.integer(round(Count)),
|
||||
KPI = display_names[kpi],
|
||||
.before = 1
|
||||
)
|
||||
df
|
||||
}), .id = NULL)
|
||||
|
||||
# Create grouped display where KPI name appears only once per group
|
||||
combined_df <- combined_df %>%
|
||||
group_by(KPI) %>%
|
||||
mutate(
|
||||
KPI_display = if_else(row_number() == 1, KPI, "")
|
||||
) %>%
|
||||
ungroup() %>%
|
||||
select(KPI_display, Level, Count, Percent) %>%
|
||||
rename(KPI = KPI_display)
|
||||
|
||||
# Render as flextable with merged cells
|
||||
ft <- flextable(combined_df) %>%
|
||||
# set_caption("Combined KPI Summary Table") %>%
|
||||
merge_v(j = "KPI") %>% # Merge vertically identical cells in KPI column
|
||||
autofit()
|
||||
|
||||
# Add horizontal lines after each KPI group
|
||||
kpi_groups <- sapply(names(summary_tables), function(kpi) nrow(summary_tables[[kpi]]))
|
||||
cum_rows <- cumsum(kpi_groups)
|
||||
for (i in seq_along(cum_rows)) {
|
||||
if (i < length(cum_rows)) {
|
||||
ft <- ft %>% hline(i = cum_rows[i], border = officer::fp_border(width = 2))
|
||||
}
|
||||
# Safely display KPI tables
|
||||
if (exists("summary_tables") && !is.null(summary_tables) && length(summary_tables) > 0) {
|
||||
|
||||
# Try to combine KPI tables, with fallback if structure is unexpected
|
||||
tryCatch({
|
||||
# Build a list of valid dataframes from summary_tables
|
||||
valid_tables <- list()
|
||||
|
||||
for (kpi_name in names(summary_tables)) {
|
||||
kpi_df <- summary_tables[[kpi_name]]
|
||||
|
||||
# Skip NULL, empty, or non-dataframe items
|
||||
if (!is.null(kpi_df) && is.data.frame(kpi_df) && nrow(kpi_df) > 0) {
|
||||
# Add KPI name as a column if not already present
|
||||
if (!"KPI" %in% names(kpi_df)) {
|
||||
display_name <- gsub("_", " ", tools::toTitleCase(gsub("_summary|_data", "", kpi_name)))
|
||||
kpi_df$KPI <- display_name
|
||||
}
|
||||
valid_tables[[kpi_name]] <- kpi_df
|
||||
}
|
||||
}
|
||||
|
||||
# Combine all valid tables
|
||||
if (length(valid_tables) > 0) {
|
||||
# Use careful bind_rows that handles mismatched columns
|
||||
combined_df <- dplyr::bind_rows(valid_tables, .id = NULL)
|
||||
|
||||
# Display as flextable
|
||||
ft <- flextable(combined_df) %>% autofit()
|
||||
ft
|
||||
} else {
|
||||
cat("No valid KPI summary tables found.\n")
|
||||
}
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error combining KPI tables:", e$message), "WARNING")
|
||||
cat("KPI summary tables could not be combined for display. Individual KPI sections will be shown below.\n")
|
||||
})
|
||||
|
||||
} else {
|
||||
cat("Note: KPI summary tables have not been loaded. Detailed KPI analysis will be available once data is computed.\n")
|
||||
}
|
||||
|
||||
ft
|
||||
```
|
||||
|
||||
## Field Alerts
|
||||
|
|
@ -367,8 +427,18 @@ ft
|
|||
```{r field_alerts_table, echo=FALSE, results='asis'}
|
||||
# Generate alerts for all fields
|
||||
generate_field_alerts <- function(field_details_table) {
|
||||
if (is.null(field_details_table) || nrow(field_details_table) == 0) {
|
||||
return(data.frame(Field = character(), Alert = character()))
|
||||
if (!exists("field_details_table") || is.null(field_details_table) || nrow(field_details_table) == 0) {
|
||||
return(NULL) # Return NULL to signal no data
|
||||
}
|
||||
|
||||
# Check for required columns
|
||||
required_cols <- c("Field", "Field Size (ha)", "Growth Uniformity", "Yield Forecast (t/ha)",
|
||||
"Gap Score", "Decline Risk", "Weed Risk", "Mean CI", "CV Value", "Moran's I")
|
||||
missing_cols <- setdiff(required_cols, colnames(field_details_table))
|
||||
|
||||
if (length(missing_cols) > 0) {
|
||||
message("Field details missing required columns: ", paste(missing_cols, collapse = ", "))
|
||||
return(NULL) # Return NULL if required columns are missing
|
||||
}
|
||||
|
||||
alerts_list <- list()
|
||||
|
|
@ -455,9 +525,9 @@ generate_field_alerts <- function(field_details_table) {
|
|||
}
|
||||
|
||||
# Generate and display alerts table
|
||||
if (exists("field_details_table") && !is.null(field_details_table)) {
|
||||
if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) {
|
||||
alerts_data <- generate_field_alerts(field_details_table)
|
||||
if (nrow(alerts_data) > 0) {
|
||||
if (!is.null(alerts_data) && nrow(alerts_data) > 0) {
|
||||
ft <- flextable(alerts_data) %>%
|
||||
# set_caption("Field Alerts Summary") %>%
|
||||
autofit()
|
||||
|
|
@ -466,29 +536,82 @@ if (exists("field_details_table") && !is.null(field_details_table)) {
|
|||
cat("No alerts data available.\n")
|
||||
}
|
||||
} else {
|
||||
cat("Field details data not available for alerts generation.\n")
|
||||
cat("Note: Field details data not available for alerts generation. Run 80_calculate_kpis.R to generate KPI data.\n")
|
||||
}
|
||||
```
|
||||
|
||||
```{r create_field_details_table, message=FALSE, warning=FALSE, include=FALSE}
|
||||
# Create field_details_table from available data
|
||||
# For projects without KPI data, create minimal table from field names/geometries
|
||||
|
||||
if (!exists("field_details_table") || is.null(field_details_table)) {
|
||||
tryCatch({
|
||||
if (!is.null(AllPivots0) && nrow(AllPivots0) > 0) {
|
||||
# Get field names from geometries
|
||||
field_names <- AllPivots0$field
|
||||
|
||||
# Try to calculate field sizes (area) from geometry if available
|
||||
field_sizes <- if ("geometry" %in% names(AllPivots0)) {
|
||||
sf::st_area(AllPivots0) / 10000 # Convert m² to hectares
|
||||
} else {
|
||||
rep(NA_real_, length(field_names))
|
||||
}
|
||||
|
||||
# Create minimal field details table with actual data we have + NAs for missing KPI columns
|
||||
field_details_table <- tibble::tibble(
|
||||
Field = field_names,
|
||||
`Field Size (ha)` = as.numeric(field_sizes),
|
||||
`Growth Uniformity` = NA_character_,
|
||||
`Yield Forecast (t/ha)` = NA_real_,
|
||||
`Gap Score` = NA_real_,
|
||||
`Decline Risk` = NA_character_,
|
||||
`Weed Risk` = NA_character_,
|
||||
`Mean CI` = NA_real_,
|
||||
`CV Value` = NA_real_,
|
||||
`Moran's I` = NA_real_
|
||||
)
|
||||
safe_log(paste("Created field_details_table from geometries for", nrow(field_details_table), "fields"))
|
||||
}
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating field_details_table from geometries:", e$message), "WARNING")
|
||||
})
|
||||
}
|
||||
```
|
||||
|
||||
```{r data, message=TRUE, warning=TRUE, include=FALSE}
|
||||
# Verify CI quadrant data is loaded from load_ci_data chunk
|
||||
if (!exists("CI_quadrant") || is.null(CI_quadrant)) {
|
||||
stop("CI_quadrant data not available - check load_ci_data chunk")
|
||||
if (!exists("CI_quadrant")) {
|
||||
safe_log("CI_quadrant not found - this may affect field analysis reports", "WARNING")
|
||||
CI_quadrant <- NULL
|
||||
} else if (is.null(CI_quadrant)) {
|
||||
safe_log("CI_quadrant data is NULL - field-level CI analysis will be skipped", "WARNING")
|
||||
} else {
|
||||
safe_log("CI quadrant data verified for field-level analysis")
|
||||
}
|
||||
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
|
||||
# Load field boundaries from GeoJSON
|
||||
tryCatch({
|
||||
boundaries_result <- load_field_boundaries(paths$data_dir)
|
||||
|
||||
if (is.list(boundaries_result) && "field_boundaries_sf" %in% names(boundaries_result)) {
|
||||
field_boundaries_sf <- boundaries_result$field_boundaries_sf
|
||||
} else {
|
||||
field_boundaries_sf <- boundaries_result
|
||||
}
|
||||
|
||||
if (nrow(field_boundaries_sf) == 0) {
|
||||
stop("No field boundaries loaded")
|
||||
}
|
||||
|
||||
AllPivots0 <- field_boundaries_sf %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field)) # Filter out NA field names
|
||||
safe_log("Successfully loaded field boundaries")
|
||||
safe_log(paste("Successfully loaded", nrow(AllPivots0), "fields"))
|
||||
|
||||
# Prepare merged field list for use in summaries
|
||||
AllPivots_merged <- AllPivots0 %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA field names
|
||||
dplyr::group_by(field) %>%
|
||||
dplyr::summarise(.groups = 'drop')
|
||||
|
||||
|
|
@ -512,18 +635,15 @@ This section provides detailed, field-specific analyses including chlorophyll in
|
|||
|
||||
\newpage
|
||||
|
||||
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, dpi=300, dev='png', message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
|
||||
# Generate detailed visualizations for each field
|
||||
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, dpi=300, dev='png', message=TRUE, echo=FALSE, warning=TRUE, include=TRUE, results='asis'}
|
||||
# Generate detailed visualizations for each field using purrr::walk
|
||||
tryCatch({
|
||||
# Merge field polygons for processing and filter out NA field names
|
||||
# Prepare merged field list and week/year info
|
||||
AllPivots_merged <- AllPivots0 %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA fields
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field)) %>%
|
||||
dplyr::group_by(field) %>%
|
||||
dplyr::summarise(.groups = 'drop')
|
||||
|
||||
# Use per-field weekly mosaic directory path from parameters_project.R
|
||||
weekly_mosaic_per_field_dir <- weekly_CI_mosaic
|
||||
|
||||
# Helper to get week/year from a date
|
||||
get_week_year <- function(date) {
|
||||
list(
|
||||
|
|
@ -532,145 +652,143 @@ tryCatch({
|
|||
)
|
||||
}
|
||||
|
||||
# Get week/year for current and historical weeks (local to field section)
|
||||
# Calculate week/year for current and historical weeks
|
||||
current_ww <- get_week_year(as.Date(today))
|
||||
minus_1_ww <- get_week_year(as.Date(today) - lubridate::weeks(1))
|
||||
minus_2_ww <- get_week_year(as.Date(today) - lubridate::weeks(2))
|
||||
minus_3_ww <- get_week_year(as.Date(today) - lubridate::weeks(3))
|
||||
|
||||
# Generate plots for each field
|
||||
for(i in seq_along(AllPivots_merged$field)) {
|
||||
field_name <- AllPivots_merged$field[i]
|
||||
|
||||
# Skip if field_name is still NA (double check)
|
||||
if(is.na(field_name)) {
|
||||
next
|
||||
message(paste("Processing", nrow(AllPivots_merged), "fields for weeks:",
|
||||
current_ww$week, minus_1_ww$week, minus_2_ww$week, minus_3_ww$week))
|
||||
|
||||
# Helper function to safely load per-field mosaic if it exists
|
||||
load_per_field_mosaic <- function(base_dir, field_name, week, year) {
|
||||
path <- file.path(base_dir, field_name, paste0("week_", sprintf("%02d", week), "_", year, ".tif"))
|
||||
if (file.exists(path)) {
|
||||
tryCatch({
|
||||
rast_obj <- terra::rast(path)
|
||||
# Extract CI band if present, otherwise first band
|
||||
if ("CI" %in% names(rast_obj)) {
|
||||
return(rast_obj[["CI"]])
|
||||
} else if (nlyr(rast_obj) > 0) {
|
||||
return(rast_obj[[1]])
|
||||
}
|
||||
}, error = function(e) {
|
||||
message(paste("Warning: Could not load", path, ":", e$message))
|
||||
return(NULL)
|
||||
})
|
||||
}
|
||||
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
# Iterate through fields using purrr::walk
|
||||
is_first_field <- TRUE
|
||||
purrr::walk(AllPivots_merged$field, function(field_name) {
|
||||
tryCatch({
|
||||
# Add page break before each field (except the first one)
|
||||
if(i > 1) {
|
||||
# Add page break before each field (except first)
|
||||
if (!is_first_field) {
|
||||
cat("\\newpage\n\n")
|
||||
}
|
||||
is_first_field <<- FALSE
|
||||
|
||||
# Load per-field mosaics directly for this field
|
||||
field_CI <- NULL
|
||||
field_CI_m1 <- NULL
|
||||
field_CI_m2 <- NULL
|
||||
field_CI_m3 <- NULL
|
||||
message(paste("Processing field:", field_name))
|
||||
|
||||
tryCatch({
|
||||
# Load per-field mosaic for current week
|
||||
per_field_path_current <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, current_ww$week, current_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_current) && file.exists(per_field_path_current)) {
|
||||
field_CI <- terra::rast(per_field_path_current)[["CI"]]
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-1
|
||||
per_field_path_m1 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_1_ww$week, minus_1_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m1) && file.exists(per_field_path_m1)) {
|
||||
field_CI_m1 <- terra::rast(per_field_path_m1)[["CI"]]
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-2
|
||||
per_field_path_m2 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_2_ww$week, minus_2_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m2) && file.exists(per_field_path_m2)) {
|
||||
field_CI_m2 <- terra::rast(per_field_path_m2)[["CI"]]
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-3
|
||||
per_field_path_m3 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_3_ww$week, minus_3_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m3) && file.exists(per_field_path_m3)) {
|
||||
field_CI_m3 <- terra::rast(per_field_path_m3)[["CI"]]
|
||||
}
|
||||
|
||||
safe_log(paste("Loaded per-field mosaics for", field_name), "DEBUG")
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Could not load per-field mosaics for", field_name, ":", e$message), "WARNING")
|
||||
})
|
||||
# Load per-field rasters for all 4 weeks
|
||||
field_CI <- load_per_field_mosaic(weekly_CI_mosaic, field_name,
|
||||
current_ww$week, current_ww$year)
|
||||
field_CI_m1 <- load_per_field_mosaic(weekly_CI_mosaic, field_name,
|
||||
minus_1_ww$week, minus_1_ww$year)
|
||||
field_CI_m2 <- load_per_field_mosaic(weekly_CI_mosaic, field_name,
|
||||
minus_2_ww$week, minus_2_ww$year)
|
||||
field_CI_m3 <- load_per_field_mosaic(weekly_CI_mosaic, field_name,
|
||||
minus_3_ww$week, minus_3_ww$year)
|
||||
|
||||
# Calculate difference rasters from per-field data (local to this field)
|
||||
last_week_dif_raster_field <- NULL
|
||||
three_week_dif_raster_field <- NULL
|
||||
|
||||
if (!is.null(field_CI) && !is.null(field_CI_m1)) {
|
||||
last_week_dif_raster_field <- field_CI - field_CI_m1
|
||||
# Calculate difference rasters
|
||||
last_week_diff <- if (!is.null(field_CI) && !is.null(field_CI_m1)) {
|
||||
field_CI - field_CI_m1
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
if (!is.null(field_CI) && !is.null(field_CI_m3)) {
|
||||
three_week_dif_raster_field <- field_CI - field_CI_m3
|
||||
|
||||
three_week_diff <- if (!is.null(field_CI) && !is.null(field_CI_m3)) {
|
||||
field_CI - field_CI_m3
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
|
||||
# Call ci_plot with field-specific rasters
|
||||
ci_plot(
|
||||
pivotName = field_name,
|
||||
field_boundaries = AllPivots0,
|
||||
current_ci = field_CI,
|
||||
ci_minus_1 = field_CI_m1,
|
||||
ci_minus_2 = field_CI_m2,
|
||||
last_week_diff = last_week_dif_raster_field,
|
||||
three_week_diff = three_week_dif_raster_field,
|
||||
harvesting_data = harvesting_data,
|
||||
week = week,
|
||||
week_minus_1 = week_minus_1,
|
||||
week_minus_2 = week_minus_2,
|
||||
week_minus_3 = week_minus_3,
|
||||
borders = borders,
|
||||
colorblind_friendly = colorblind_friendly
|
||||
)
|
||||
|
||||
cat("\n\n")
|
||||
|
||||
# Special handling for ESA project field 00f25 - remove duplicate DOY values
|
||||
if (project_dir == "esa" && field_name == "00F25") {
|
||||
ci_quadrant_data <- CI_quadrant %>%
|
||||
filter(field == "00F25") %>%
|
||||
arrange(DOY) %>%
|
||||
group_by(DOY) %>%
|
||||
slice(1) %>%
|
||||
ungroup()
|
||||
if (!is.null(field_CI)) {
|
||||
ci_plot(
|
||||
pivotName = field_name,
|
||||
field_boundaries = AllPivots0,
|
||||
current_ci = field_CI,
|
||||
ci_minus_1 = field_CI_m1,
|
||||
ci_minus_2 = field_CI_m2,
|
||||
last_week_diff = last_week_diff,
|
||||
three_week_diff = three_week_diff,
|
||||
harvesting_data = harvesting_data,
|
||||
week = week,
|
||||
week_minus_1 = week_minus_1,
|
||||
week_minus_2 = week_minus_2,
|
||||
week_minus_3 = week_minus_3,
|
||||
borders = borders,
|
||||
colorblind_friendly = colorblind_friendly
|
||||
)
|
||||
cat("\n\n")
|
||||
} else {
|
||||
ci_quadrant_data <- CI_quadrant
|
||||
message(paste("Warning: No raster data found for field", field_name))
|
||||
}
|
||||
|
||||
# Call cum_ci_plot with explicit parameters
|
||||
cum_ci_plot(
|
||||
pivotName = field_name,
|
||||
ci_quadrant_data = ci_quadrant_data,
|
||||
plot_type = ci_plot_type,
|
||||
facet_on = facet_by_season,
|
||||
x_unit = x_axis_unit,
|
||||
colorblind_friendly = colorblind_friendly,
|
||||
show_benchmarks = TRUE,
|
||||
estate_name = project_dir,
|
||||
benchmark_percentiles = c(10, 50, 90),
|
||||
benchmark_data = benchmarks
|
||||
)
|
||||
# Handle CI quadrant data filter for special cases
|
||||
ci_quadrant_data <- if (project_dir == "esa" && field_name == "00F25") {
|
||||
CI_quadrant %>%
|
||||
dplyr::filter(field == "00F25") %>%
|
||||
dplyr::arrange(DOY) %>%
|
||||
dplyr::group_by(DOY) %>%
|
||||
dplyr::slice(1) %>%
|
||||
dplyr::ungroup()
|
||||
} else {
|
||||
CI_quadrant
|
||||
}
|
||||
|
||||
cat("\n\n")
|
||||
|
||||
# Add field-specific KPI summary under the graphs
|
||||
if (exists("field_details_table") && !is.null(field_details_table)) {
|
||||
kpi_summary <- generate_field_kpi_summary(field_name, field_details_table, CI_quadrant)
|
||||
cat(kpi_summary)
|
||||
# Call cum_ci_plot for trend analysis
|
||||
if (!is.null(CI_quadrant)) {
|
||||
cum_ci_plot(
|
||||
pivotName = field_name,
|
||||
ci_quadrant_data = ci_quadrant_data,
|
||||
plot_type = ci_plot_type,
|
||||
facet_on = facet_by_season,
|
||||
x_unit = x_axis_unit,
|
||||
colorblind_friendly = colorblind_friendly,
|
||||
show_benchmarks = TRUE,
|
||||
estate_name = project_dir,
|
||||
benchmark_percentiles = c(10, 50, 90),
|
||||
benchmark_data = benchmarks
|
||||
)
|
||||
cat("\n\n")
|
||||
}
|
||||
|
||||
# Add field-specific KPI summary if available
|
||||
# NOTE: generate_field_kpi_summary function not yet implemented
|
||||
# Skipping field-level KPI text for now; KPI tables are available in Section 1
|
||||
if (FALSE) { # Disabled pending function implementation
|
||||
# if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) {
|
||||
# kpi_summary <- generate_field_kpi_summary(field_name, field_details_table, CI_quadrant)
|
||||
# if (!is.null(kpi_summary)) {
|
||||
# cat(kpi_summary)
|
||||
# cat("\n\n")
|
||||
# }
|
||||
# }
|
||||
}
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
|
||||
cat("\\newpage\n\n")
|
||||
cat("# Error generating plots for field ", field_name, "\n\n")
|
||||
cat(e$message, "\n\n")
|
||||
cat(paste("Error:", e$message), "\n\n")
|
||||
})
|
||||
}
|
||||
})
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error in field visualization section:", e$message), "ERROR")
|
||||
cat("Error generating field plots. See log for details.\n\n")
|
||||
|
|
@ -717,32 +835,41 @@ tryCatch({
|
|||
The following table provides a comprehensive overview of all monitored fields with their key performance metrics from the KPI analysis.
|
||||
|
||||
```{r detailed_field_table, echo=FALSE, results='asis'}
|
||||
# Load CI quadrant data to get field ages
|
||||
#CI_quadrant <- readRDS(here::here(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
|
||||
|
||||
# Identify the current season for each field based on report_date
|
||||
# The current season is the one where the report_date falls within or shortly after the season
|
||||
# Detailed field performance table
|
||||
report_date_obj <- as.Date(report_date)
|
||||
|
||||
current_seasons <- CI_quadrant %>%
|
||||
filter(Date <= report_date_obj) %>%
|
||||
group_by(field, season) %>%
|
||||
summarise(
|
||||
season_start = min(Date),
|
||||
season_end = max(Date),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
group_by(field) %>%
|
||||
filter(season == max(season)) %>% # Take the most recent season
|
||||
select(field, season)
|
||||
# Initialize empty dataframe for field_ages if CI_quadrant is unavailable
|
||||
field_ages <- data.frame(Field = character(), Age_days = numeric())
|
||||
|
||||
# Get current field ages (most recent DOY for each field in their CURRENT SEASON only)
|
||||
field_ages <- CI_quadrant %>%
|
||||
inner_join(current_seasons, by = c("field", "season")) %>% # Filter to current season only
|
||||
group_by(field) %>%
|
||||
filter(DOY == max(DOY)) %>%
|
||||
select(field, DOY) %>%
|
||||
rename(Field = field, Age_days = DOY)
|
||||
# Try to get field ages from CI quadrant if available
|
||||
if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) {
|
||||
tryCatch({
|
||||
# Identify the current season for each field based on report_date
|
||||
current_seasons <- CI_quadrant %>%
|
||||
filter(Date <= report_date_obj) %>%
|
||||
group_by(field, season) %>%
|
||||
summarise(
|
||||
season_start = min(Date),
|
||||
season_end = max(Date),
|
||||
.groups = 'drop'
|
||||
) %>%
|
||||
group_by(field) %>%
|
||||
filter(season == max(season)) %>%
|
||||
select(field, season)
|
||||
|
||||
# Get current field ages (most recent DOY for each field in their CURRENT SEASON only)
|
||||
field_ages <- CI_quadrant %>%
|
||||
inner_join(current_seasons, by = c("field", "season")) %>%
|
||||
group_by(field) %>%
|
||||
filter(DOY == max(DOY)) %>%
|
||||
select(field, DOY) %>%
|
||||
rename(Field = field, Age_days = DOY)
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error extracting field ages:", e$message), "WARNING")
|
||||
})
|
||||
} else {
|
||||
safe_log("CI quadrant data unavailable - field ages will not be included in detailed table", "WARNING")
|
||||
}
|
||||
|
||||
# Clean up the field details table - remove sub field column and round numeric values
|
||||
# Check if field_details_table was loaded successfully
|
||||
|
|
|
|||
|
|
@ -438,9 +438,9 @@
|
|||
# rmarkdown::render(
|
||||
rmarkdown::render(
|
||||
"r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
|
||||
params = list(data_dir = "angata", report_date = as.Date("2026-02-04")),
|
||||
output_file = "SmartCane_Report_agronomic_support_aura_2026-02-10_FIXED.docx",
|
||||
output_dir = "laravel_app/storage/app/angata/reports"
|
||||
params = list(data_dir = "john", report_date = as.Date("2026-02-04")),
|
||||
output_file = "SmartCane_Report_agronomic_support_john_2026-02-04.docx",
|
||||
output_dir = "laravel_app/storage/app/john/reports"
|
||||
)
|
||||
#
|
||||
# COMMAND #2 - CANE SUPPLY REPORT (ANGATA, CHEMBA, XINAVANE, ESA):
|
||||
|
|
|
|||
|
|
@ -39,11 +39,7 @@ suppressPackageStartupMessages({
|
|||
# This determines which scripts run and what outputs they produce
|
||||
|
||||
CLIENT_TYPE_MAP <- list(
|
||||
"angata" = "cane_supply",
|
||||
"aura" = "agronomic_support",
|
||||
"chemba" = "cane_supply",
|
||||
"xinavane" = "cane_supply",
|
||||
"esa" = "cane_supply"
|
||||
"angata" = "cane_supply"
|
||||
)
|
||||
|
||||
#' Get client type for a project
|
||||
|
|
@ -52,8 +48,7 @@ CLIENT_TYPE_MAP <- list(
|
|||
get_client_type <- function(project_name) {
|
||||
client_type <- CLIENT_TYPE_MAP[[project_name]]
|
||||
if (is.null(client_type)) {
|
||||
warning(sprintf("Project '%s' not in CLIENT_TYPE_MAP - defaulting to 'cane_supply'", project_name))
|
||||
return("cane_supply")
|
||||
return("agronomic_support") # Default for all unlisted projects
|
||||
}
|
||||
return(client_type)
|
||||
}
|
||||
|
|
|
|||
32
r_app/test_kpi_structure.R
Normal file
32
r_app/test_kpi_structure.R
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
#!/usr/bin/env Rscript
|
||||
# Temporary script to inspect KPI structure
|
||||
|
||||
x <- readRDS('laravel_app/storage/app/john/reports/kpis/field_level/AURA_KPI_week_06_2026.rds')
|
||||
|
||||
cat("===== KPI RDS Structure =====\n")
|
||||
cat("Names:", paste(names(x), collapse=", "), "\n\n")
|
||||
|
||||
cat("---- UNIFORMITY TABLE ----\n")
|
||||
cat("Class:", class(x$uniformity), "\n")
|
||||
if (is.data.frame(x$uniformity)) {
|
||||
cat("Columns:", paste(names(x$uniformity), collapse=", "), "\n")
|
||||
print(head(x$uniformity, 3))
|
||||
} else if (is.list(x$uniformity)) {
|
||||
cat("List contents:", paste(names(x$uniformity), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---- AREA CHANGE TABLE ----\n")
|
||||
cat("Class:", class(x$area_change), "\n")
|
||||
if (is.data.frame(x$area_change)) {
|
||||
cat("Columns:", paste(names(x$area_change), collapse=", "), "\n")
|
||||
print(head(x$area_change, 3))
|
||||
} else if (is.list(x$area_change)) {
|
||||
cat("List contents:", paste(names(x$area_change), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---- TCH FORECASTED TABLE ----\n")
|
||||
cat("Class:", class(x$tch_forecasted), "\n")
|
||||
if (is.data.frame(x$tch_forecasted)) {
|
||||
cat("Columns:", paste(names(x$tch_forecasted), collapse=", "), "\n")
|
||||
print(head(x$tch_forecasted, 3))
|
||||
}
|
||||
35
test_rds_structure.R
Normal file
35
test_rds_structure.R
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
# Load the created RDS file
|
||||
rds_file <- "laravel_app/storage/app/john/reports/kpis/field_level/john_kpi_summary_tables_week06_2026.rds"
|
||||
data <- readRDS(rds_file)
|
||||
|
||||
# Check structure
|
||||
cat("Top-level structure:\n")
|
||||
cat("Names:", paste(names(data), collapse=", "), "\n")
|
||||
cat("Has summary_tables:", "summary_tables" %in% names(data), "\n")
|
||||
cat("Has all_kpis:", "all_kpis" %in% names(data), "\n")
|
||||
cat("Has field_details:", "field_details" %in% names(data), "\n\n")
|
||||
|
||||
# Check summary_tables structure
|
||||
if (!is.null(data$summary_tables)) {
|
||||
cat("Summary tables (KPI names):\n")
|
||||
cat(" -", paste(names(data$summary_tables), collapse=", "), "\n\n")
|
||||
|
||||
# Check one example
|
||||
cat("Uniformity KPI (first 3 rows):\n")
|
||||
print(head(data$summary_tables$uniformity, 3))
|
||||
}
|
||||
|
||||
cat("\n---\n")
|
||||
cat("all_kpis structure:\n")
|
||||
if (!is.null(data$all_kpis)) {
|
||||
cat(" -", paste(names(data$all_kpis), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---\n")
|
||||
cat("field_details structure:\n")
|
||||
if (!is.null(data$field_details)) {
|
||||
cat("Columns:", paste(colnames(data$field_details), collapse=", "), "\n")
|
||||
print(data$field_details)
|
||||
} else {
|
||||
cat(" NULL (expected if field_boundaries_sf had issues)\n")
|
||||
}
|
||||
22
test_render_90.R
Normal file
22
test_render_90.R
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
# Test rendering of 90 report
|
||||
library(rmarkdown)
|
||||
|
||||
# Use "john" project since it has the KPI data we just created
|
||||
render(
|
||||
input = "r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
|
||||
params = list(
|
||||
data_dir = "john",
|
||||
report_date = "2026-02-04",
|
||||
mail_day = "Monday",
|
||||
borders = FALSE,
|
||||
ci_plot_type = "mosaic",
|
||||
colorblind_friendly = FALSE,
|
||||
facet_by_season = FALSE,
|
||||
x_axis_unit = "days"
|
||||
),
|
||||
output_file = "test_90_john_2026_02_04.docx",
|
||||
output_dir = "output",
|
||||
quiet = FALSE
|
||||
)
|
||||
|
||||
cat("\n✓ Report rendered!\n")
|
||||
Loading…
Reference in a new issue