Refactor KPI calculation scripts for improved error handling and clarity
This commit is contained in:
parent
b1b96e6c6a
commit
f2da320fb6
|
|
@ -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)")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) %>%
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue