Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Refactor KPI export function to excel file that matches cane supply strycture

Browse source
This commit is contained in:
DimitraVeropoulou 2026-02-16 11:04:31 +01:00
parent a9840171cb
commit 951eb487b8
2 changed files with 105 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
r_app/80_calculate_kpis.R
View file

@ -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")

165
r_app/80_utils_agronomic_support.R
View file

@ -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
)
))
}