From 951eb487b8432f5b51b970c6c6022ae61b9871b7 Mon Sep 17 00:00:00 2001 From: DimitraVeropoulou Date: Mon, 16 Feb 2026 11:04:31 +0100 Subject: [PATCH] Refactor KPI export function to excel file that matches cane supply strycture --- r_app/80_calculate_kpis.R | 4 + r_app/80_utils_agronomic_support.R | 165 ++++++++++++++++++----------- 2 files changed, 105 insertions(+), 64 deletions(-) diff --git a/r_app/80_calculate_kpis.R b/r_app/80_calculate_kpis.R index 65496ce..1b481c9 100644 --- a/r_app/80_calculate_kpis.R +++ b/r_app/80_calculate_kpis.R @@ -381,6 +381,10 @@ main <- function() { output_dir = reports_dir_kpi, project_dir = project_dir ) + + # Extract results + field_analysis_df <- kpi_results$field_analysis_df + export_paths <- kpi_results$export_paths cat("\n=== KPI CALCULATION COMPLETE ===\n") cat("Summary tables saved for Script 90 integration\n") diff --git a/r_app/80_utils_agronomic_support.R b/r_app/80_utils_agronomic_support.R index 7bf6ebd..aecc837 100644 --- a/r_app/80_utils_agronomic_support.R +++ b/r_app/80_utils_agronomic_support.R @@ -464,35 +464,81 @@ create_summary_tables <- function(all_kpis) { return(kpi_summary) } -#' Create detailed field-by-field KPI report +#' Create detailed field-by-field KPI report (ALL KPIs in one row) #' -#' @param field_df Data frame with field identifiers and acreage -#' @param all_kpis List with all KPI results #' @param field_boundaries_sf SF object with field boundaries +#' @param all_kpis List with all KPI results +#' @param current_week Current week number +#' @param current_year Current year #' #' @return Data frame with one row per field, all KPI columns -create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) { - result <- field_df %>% +create_field_detail_table <- function(field_boundaries_sf, all_kpis, current_week, current_year) { + + # Start with field identifiers AND field_idx for joining + result <- field_boundaries_sf %>% + sf::st_drop_geometry() %>% + mutate( + field_idx = row_number(), # ADD THIS: match the integer index used in KPI functions + Field_id = field, + Field_name = field, + Week = current_week, + Year = current_year + ) %>% + select(field_idx, Field_id, Field_name, Week, Year) # Include field_idx first + + # Join all KPI results (now field_idx matches on both sides) + result <- result %>% left_join( - all_kpis$uniformity %>% select(field_idx, cv_value, uniformity_interpretation = interpretation), - by = c("field_idx") + all_kpis$uniformity %>% + select(field_idx, CV = cv_value, Uniformity_Score = uniformity_score, + Morans_I = morans_i, Uniformity_Interpretation = interpretation), + by = "field_idx" ) %>% left_join( - all_kpis$area_change %>% select(field_idx, mean_ci_pct_change), - by = c("field_idx") + all_kpis$area_change %>% + select(field_idx, Weekly_CI_Change = mean_ci_pct_change, + Area_Change_Interpretation = interpretation), + by = "field_idx" ) %>% left_join( - all_kpis$tch_forecasted %>% select(field_idx, tch_forecasted), - by = c("field_idx") + all_kpis$tch_forecasted %>% + select(field_idx, Mean_CI = mean_ci, TCH_Forecasted = tch_forecasted, + TCH_Lower = tch_lower_bound, TCH_Upper = tch_upper_bound, + TCH_Confidence = confidence), + by = "field_idx" ) %>% left_join( - all_kpis$growth_decline %>% select(field_idx, decline_severity), - by = c("field_idx") + all_kpis$growth_decline %>% + select(field_idx, Four_Week_Trend = four_week_trend, + Trend_Interpretation = trend_interpretation, + Decline_Severity = decline_severity), + by = "field_idx" ) %>% left_join( - all_kpis$weed_presence %>% select(field_idx, weed_pressure_risk), - by = c("field_idx") - ) + all_kpis$weed_presence %>% + select(field_idx, Fragmentation_Index = fragmentation_index, + Weed_Pressure_Risk = weed_pressure_risk), + by = "field_idx" + ) + + # Add gap filling if available + if (!is.null(all_kpis$gap_filling) && nrow(all_kpis$gap_filling) > 0) { + result <- result %>% + left_join( + all_kpis$gap_filling %>% + select(field_idx, Gap_Score = gap_score, Gap_Level = gap_level), + by = "field_idx" + ) + } + + # Remove field_idx from final output (it was only needed for joining) + result <- result %>% + select(-field_idx) + + # Round numeric columns + result <- result %>% + mutate(across(where(is.numeric), ~ round(., 2))) + return(result) } @@ -515,56 +561,28 @@ create_field_kpi_text <- function(all_kpis) { return(paste(text_parts, collapse = "")) } -#' Export detailed KPI data to Excel/RDS +#' Export detailed KPI data to Excel/RDS #' -#' @param all_kpis List with all KPI results -#' @param kpi_summary List with summary tables +#' @param field_detail_df Data frame with all KPI columns (one row per field) +#' @param kpi_summary List with summary tables (optional, for metadata) #' @param output_dir Directory for output files #' @param week Week number #' @param year Year +#' @param project_dir Project name #' @return List of output file paths -export_kpi_data <- function(all_kpis, kpi_summary, output_dir, week, year, project_dir) { - # Ensure output directory exists - if (!dir.exists(output_dir)) { - dir.create(output_dir, recursive = TRUE) - } +export_kpi_data <- function(field_detail_df, kpi_summary, output_dir, week, year, project_dir) { - # Export all KPI tables to a single Excel file - excel_file <- paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".xlsx") - excel_path <- file.path(output_dir, excel_file) - - sheets <- list( - "Uniformity" = as.data.frame(kpi_summary$uniformity), - "Area_Change" = as.data.frame(kpi_summary$area_change), - "TCH_Forecast" = as.data.frame(kpi_summary$tch_forecast), - "Growth_Decline" = as.data.frame(kpi_summary$growth_decline), - "Weed_Pressure" = as.data.frame(kpi_summary$weed_pressure), - "Gap_Filling" = as.data.frame(kpi_summary$gap_filling) + # Use the common export function from 80_utils_common.R + export_paths <- export_field_analysis_excel( + field_df = field_detail_df, + summary_df = NULL, # No separate summary sheet for agronomic support + project_dir = project_dir, + current_week = week, + year = year, + reports_dir = output_dir ) - write_xlsx(sheets, excel_path) - message(paste("āœ“ AURA KPI data exported to:", excel_path)) - - # Also export to RDS for programmatic access - rds_file <- paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".rds") - rds_path <- file.path(output_dir, rds_file) - - # Save complete structure including metadata - kpi_export_data <- list( - kpis = all_kpis, - summary_tables = kpi_summary, - metadata = list( - week = week, - year = year, - project = project_dir, - created_at = Sys.time() - ) - ) - - saveRDS(kpi_export_data, rds_path) - message(paste("āœ“ AURA KPI RDS exported to:", rds_path)) - - return(list(excel = excel_path, rds = rds_path)) + return(export_paths) } # ============================================================================ @@ -685,22 +703,41 @@ calculate_all_field_analysis_agronomic_support <- function( gap_filling = gap_filling_kpi ) + # Built single-sheet field detail table with all KPIs + message("\nBuilding comprehensive field detail table...") + field_detail_df <- create_field_detail_table( + field_boundaries_sf = field_boundaries_sf, + all_kpis = all_kpis, + current_week = current_week, + current_year = current_year + ) + # Create summary tables message("\nCreating summary tables...") kpi_summary <- create_summary_tables(all_kpis) # Export - message("\nExporting KPI data...") - export_paths <- export_kpi_data(all_kpis, kpi_summary, output_dir, current_week, current_year, project_dir) + message("\nExporting KPI data (single-sheet format)...") + export_paths <- export_kpi_data( + field_detail_df = field_detail_df, + kpi_summary = kpi_summary, + output_dir = output_dir, + week = current_week, + year = current_year, + project_dir = project_dir + ) message(paste("\nāœ“ AURA KPI calculation complete. Week", current_week, current_year)) return(list( - kpis = all_kpis, - summary_tables = kpi_summary, + field_analysis_df = field_detail_df, + kpis = all_kpis, + summary_tables = kpi_summary, + export_paths = export_paths, metadata = list( week = current_week, year = current_year, - project = project_dir, - export_paths = export_paths) )) + project = project_dir + ) + )) }