Refactor KPI calculation scripts for improved error handling and clarity

This commit is contained in:
Timon 2026-02-10 16:12:07 +01:00
parent b1b96e6c6a
commit f2da320fb6
5 changed files with 66 additions and 30 deletions

View file

@ -506,11 +506,10 @@ main <- function() {
message("WARNING: No planting dates available. Using NA for all fields.")
planting_dates <- data.frame(
field_id = field_boundaries_sf$field,
date = rep(as.Date(NA), nrow(field_boundaries_sf)),
planting_date = rep(as.Date(NA), nrow(field_boundaries_sf)),
stringsAsFactors = FALSE
)
}
}
# Build per-field configuration
message("\nPreparing mosaic configuration for statistics calculation...")
message(" ✓ Using per-field mosaic architecture (1 TIFF per field)")

View file

@ -368,9 +368,8 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
field_results <- data.frame()
for (i in seq_len(nrow(field_boundaries))) {
field_name <- field_boundaries$field[i]
sub_field_name <- field_boundaries$sub_field[i]
field_vect <- field_boundaries_vect[i]
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
ci_values <- extract_ci_values(ci_raster, field_vect)

View file

@ -168,7 +168,7 @@ if (!is.null(summary_file) && file.exists(summary_file)) {
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 <- kpi_files_exist && TRUE
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")
}
@ -235,6 +235,20 @@ tryCatch({
# NOTE: Overview maps skipped for this report
# Individual field sections load their own per-field mosaics directly
# Load harvesting data (required for ci_plot() function)
tryCatch({
harvesting_data <- load_harvesting_data(paths$data_dir)
if (!is.null(harvesting_data)) {
safe_log(paste("Successfully loaded harvesting data:", nrow(harvesting_data), "records"))
} else {
safe_log("No harvesting data available - ci_plot() will work with limited functionality", "WARNING")
harvesting_data <- NULL
}
}, error = function(e) {
safe_log(paste("Error loading harvesting data:", e$message), "ERROR")
harvesting_data <<- NULL
})
```
@ -731,17 +745,33 @@ field_ages <- CI_quadrant %>%
rename(Field = field, Age_days = DOY)
# Clean up the field details table - remove sub field column and round numeric values
field_details_clean <- field_details_table %>%
left_join(field_ages, by = "Field") %>%
mutate(
`Yield Forecast (t/ha)` = ifelse(is.na(Age_days) | Age_days < 240, NA_real_, `Yield Forecast (t/ha)`)
) %>%
select(Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`, `Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`) %>% # Reorder columns as requested
mutate(
`Mean CI` = round(`Mean CI`, 2), # Round to 2 decimal places
`CV Value` = round(`CV Value`, 2), # Round to 2 decimal places
`Gap Score` = round(`Gap Score`, 0) # Round to nearest integer
# Check if field_details_table was loaded successfully
if (!exists("field_details_table") || is.null(field_details_table)) {
# Initialize empty tibble with expected columns
field_details_clean <- tibble(
Field = character(),
`Field Size (ha)` = numeric(),
`Growth Uniformity` = character(),
`Yield Forecast (t/ha)` = numeric(),
`Gap Score` = numeric(),
`Decline Risk` = character(),
`Weed Risk` = character(),
`Mean CI` = numeric(),
`CV Value` = numeric()
)
} else {
field_details_clean <- field_details_table %>%
left_join(field_ages, by = "Field") %>%
mutate(
`Yield Forecast (t/ha)` = ifelse(is.na(Age_days) | Age_days < 240, NA_real_, `Yield Forecast (t/ha)`)
) %>%
select(Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`, `Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`) %>% # Reorder columns as requested
mutate(
`Mean CI` = round(`Mean CI`, 2), # Round to 2 decimal places
`CV Value` = round(`CV Value`, 2), # Round to 2 decimal places
`Gap Score` = round(`Gap Score`, 0) # Round to nearest integer
)
}
# Display the cleaned field table with flextable

View file

@ -242,10 +242,8 @@ if (!is.null(field_details_file) && file.exists(field_details_file)) {
# Try to extract field_details from summary_data if available
if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
field_details_table <- summary_data$field_analysis %>%
rename(`Mean CI` = Acreage, `CV Value` = CV, Field = Field_id)
safe_log("Extracted field details from field_analysis data")
}
}
rename(`Mean CI` = Mean_CI, `CV Value` = CV, Field = Field_id)
safe_log("Extracted field details from field_analysis data")}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
@ -302,8 +300,6 @@ if (!is.null(cloud_file) && file.exists(cloud_file)) {
}
```
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE, eval=TRUE}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
@ -475,6 +471,11 @@ tryCatch({
warning("Error loading field analysis data:", e$message)
})
# Fallback: if analysis_data failed to load, create an empty tibble with required columns
if (!exists("analysis_data") || is.null(analysis_data)) {
analysis_data <- tibble(Field_id = character(), Status_trigger = character())
}
# Define constants
ACRE_CONV <- 4046.856
TARGET_CRS <- 32736
@ -785,12 +786,12 @@ if (cloud_coverage_available && !is.null(per_field_cloud_coverage)) {
# Handle both old and new column naming conventions
cloud_display <- per_field_cloud_coverage %>%
mutate(
Field = if_else(exists("field", list(per_field_cloud_coverage)), field_id,
if_else(exists("Field", list(per_field_cloud_coverage)), Field, field_id)),
Field = if_else("field" %in% names(per_field_cloud_coverage), field_id,
if_else("Field" %in% names(per_field_cloud_coverage), Field, field_id)),
Clear_Percent = pct_clear,
Cloud_Acreage = if_else(exists("Cloud_Acreage", list(per_field_cloud_coverage)), Cloud_Acreage,
Cloud_Acreage = if_else("Cloud_Acreage" %in% names(per_field_cloud_coverage), Cloud_Acreage,
as.numeric(NA)),
Total_Acreage = if_else(exists("Total_Acreage", list(per_field_cloud_coverage)), Total_Acreage,
Total_Acreage = if_else("Total_Acreage" %in% names(per_field_cloud_coverage), Total_Acreage,
as.numeric(NA))
) %>%
select(Field, Cloud_category, Clear_Percent, missing_pixels, clear_pixels, total_pixels) %>%

View file

@ -235,12 +235,19 @@ main <- function() {
file_path <- files_to_delete[[i]]
if (!DRY_RUN) {
tryCatch({
# file.remove() returns logical; check the return value
success <- tryCatch({
file.remove(file_path)
deleted_count <- deleted_count + 1
}, error = function(e) {
error_count <<- error_count + 1
# If unexpected exception, treat as failure
FALSE
})
if (isTRUE(success)) {
deleted_count <- deleted_count + 1
} else {
error_count <- error_count + 1
}
}
}