From b1b96e6c6a6fbaea3f1c02c857675168308f11fb Mon Sep 17 00:00:00 2001 From: Timon Date: Tue, 10 Feb 2026 16:01:59 +0100 Subject: [PATCH] gap filling worked to per-field --- r_app/80_calculate_kpis.R | 176 ++++++------------ r_app/80_utils_agronomic_support.R | 2 - ...CI_report_with_kpis_agronomic_support.Rmd} | 0 ...=> 91_CI_report_with_kpis_cane_supply.Rmd} | 0 r_app/DEBUG_remove_date_tiffs.R | 5 +- 5 files changed, 61 insertions(+), 122 deletions(-) rename r_app/{90_CI_report_with_kpis_simple.Rmd => 90_CI_report_with_kpis_agronomic_support.Rmd} (100%) rename r_app/{91_CI_report_with_kpis_Angata.Rmd => 91_CI_report_with_kpis_cane_supply.Rmd} (100%) diff --git a/r_app/80_calculate_kpis.R b/r_app/80_calculate_kpis.R index 5d1c415..c18fab0 100644 --- a/r_app/80_calculate_kpis.R +++ b/r_app/80_calculate_kpis.R @@ -598,126 +598,68 @@ main <- function() { message("\nCalculating gap filling scores (2σ method)...") - # Try single merged mosaic first, then fall back to merging tiles - week_mosaic_file <- file.path(mosaic_dir, sprintf("week_%02d_%d.tif", current_week, current_year)) + # Process per-field mosaics + message(paste(" Using per-field mosaics for", length(per_field_files), "fields")) - gap_scores_df <- NULL + field_boundaries_by_id <- split(field_boundaries_sf, field_boundaries_sf$field) - if (file.exists(week_mosaic_file)) { - # Single merged mosaic exists - use it directly - tryCatch({ - current_week_raster <- terra::rast(week_mosaic_file) - # Extract CI band by name (not assumed position) - # Extract CI band (5th band in mosaic) - ci_band_name <- "CI" - if (!(ci_band_name %in% names(current_week_raster))) { - stop(paste("ERROR: CI band not found in mosaic. Available bands:", - paste(names(current_week_raster), collapse = ", "))) - } - current_ci_band <- current_week_raster[[ci_band_name]] - names(current_ci_band) <- "CI" - if (!(ci_band_name %in% names(current_week_raster))) { - stop(paste("ERROR: CI band not found in mosaic. Available bands:", - paste(names(current_week_raster), collapse = ", "))) - } - current_ci_band <- current_week_raster[[ci_band_name]] - names(current_ci_band) <- "CI" - - message(paste(" Loaded single mosaic:", week_mosaic_file)) - - # Calculate gap scores for all fields - gap_result <- calculate_gap_filling_kpi(current_ci_band, field_boundaries_sf) - - # Extract field-level results (use field column directly to match current_stats Field_id) - gap_scores_df <- gap_result$field_results %>% - mutate(Field_id = field) %>% - select(Field_id, gap_score) - - message(paste(" ✓ Calculated gap scores for", nrow(gap_scores_df), "fields")) - message(paste(" Gap score range:", round(min(gap_scores_df$gap_score, na.rm=TRUE), 2), "-", round(max(gap_scores_df$gap_score, na.rm=TRUE), 2), "%")) - - }, error = function(e) { - message(paste(" WARNING: Could not calculate gap scores from single mosaic:", e$message)) - message(" Gap scores will be set to NA") - gap_scores_df <- NULL - }) - - } else { - # Single mosaic doesn't exist - check for tiles and process per-tile - message(" Single mosaic not found. Checking for tiles...") - - # List all tiles for this week (e.g., week_04_2026_01.tif through week_04_2026_25.tif) - tile_pattern <- sprintf("week_%02d_%d_\\d{2}\\.tif$", current_week, current_year) - tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE) - - if (length(tile_files) == 0) { - message(sprintf(" WARNING: No tiles found matching pattern: %s in %s", tile_pattern, mosaic_dir)) - message(" Gap scores will be set to NA") - - } else { - tryCatch({ - message(sprintf(" Found %d tiles. Processing per-tile (memory efficient)...", length(tile_files))) - - # Process each tile separately and accumulate results - all_tile_results <- list() - - for (i in seq_along(tile_files)) { - tile_file <- tile_files[i] - - # Load tile raster - tile_raster <- terra::rast(tile_file) - - # Extract CI band by name (not assumed position) - ci_band_name <- "CI" - if (!(ci_band_name %in% names(tile_raster))) { - stop(paste("ERROR: CI band not found in tile mosaic. Available bands:", - paste(names(tile_raster), collapse = ", "))) - } - tile_ci_band <- tile_raster[[ci_band_name]] - names(tile_ci_band) <- "CI" - - # Calculate gap scores for fields in this tile - tile_gap_result <- calculate_gap_filling_kpi(tile_ci_band, field_boundaries_sf) - - # Store results (only keep fields with non-NA scores, use field directly to match current_stats) - if (!is.null(tile_gap_result$field_results) && nrow(tile_gap_result$field_results) > 0) { - tile_results_clean <- tile_gap_result$field_results %>% - mutate(Field_id = field) %>% - select(Field_id, gap_score) %>% - filter(!is.na(gap_score)) - - if (nrow(tile_results_clean) > 0) { - all_tile_results[[i]] <- tile_results_clean - } - } - - # Clear memory - rm(tile_raster, tile_ci_band, tile_gap_result) - gc(verbose = FALSE) - } - - # Combine all tile results - if (length(all_tile_results) > 0) { - gap_scores_df <- bind_rows(all_tile_results) - - # If a field appears in multiple tiles, take the maximum gap score - gap_scores_df <- gap_scores_df %>% - group_by(Field_id) %>% - summarise(gap_score = max(gap_score, na.rm = TRUE), .groups = "drop") - - message(paste(" ✓ Calculated gap scores for", nrow(gap_scores_df), "fields across", length(all_tile_results), "tiles")) - message(paste(" Gap score range:", round(min(gap_scores_df$gap_score, na.rm=TRUE), 2), "-", round(max(gap_scores_df$gap_score, na.rm=TRUE), 2), "%")) - } else { - message(" WARNING: No gap scores calculated from any tiles") - gap_scores_df <- NULL - } - - }, error = function(e) { - message(paste(" WARNING: Could not process tiles or calculate gap scores:", e$message)) - message(" Gap scores will be set to NA") - gap_scores_df <- NULL - }) + process_gap_for_field <- function(field_file) { + field_id <- basename(dirname(field_file)) + field_bounds <- field_boundaries_by_id[[field_id]] + + if (is.null(field_bounds) || nrow(field_bounds) == 0) { + return(data.frame(Field_id = field_id, gap_score = NA_real_)) } + + tryCatch({ + field_raster <- terra::rast(field_file) + ci_band_name <- "CI" + if (!(ci_band_name %in% names(field_raster))) { + return(data.frame(Field_id = field_id, gap_score = NA_real_)) + } + field_ci_band <- field_raster[[ci_band_name]] + names(field_ci_band) <- "CI" + + gap_result <- calculate_gap_filling_kpi(field_ci_band, field_bounds) + + if (is.null(gap_result) || is.null(gap_result$field_results) || nrow(gap_result$field_results) == 0) { + return(data.frame(Field_id = field_id, gap_score = NA_real_)) + } + + gap_scores <- gap_result$field_results + gap_scores$Field_id <- gap_scores$field + gap_scores <- gap_scores[, c("Field_id", "gap_score")] + + stats::aggregate(gap_score ~ Field_id, data = gap_scores, FUN = function(x) mean(x, na.rm = TRUE)) + }, error = function(e) { + message(paste(" WARNING: Gap score failed for field", field_id, ":", e$message)) + data.frame(Field_id = field_id, gap_score = NA_real_) + }) + } + + # Process fields sequentially with progress bar + message(" Processing gap scores for ", length(per_field_files), " fields...") + pb <- utils::txtProgressBar(min = 0, max = length(per_field_files), style = 3, width = 50) + + results_list <- lapply(seq_along(per_field_files), function(idx) { + result <- process_gap_for_field(per_field_files[[idx]]) + utils::setTxtProgressBar(pb, idx) + result + }) + close(pb) + + gap_scores_df <- dplyr::bind_rows(results_list) + + if (!is.null(gap_scores_df) && nrow(gap_scores_df) > 0) { + gap_scores_df <- gap_scores_df %>% + dplyr::group_by(Field_id) %>% + dplyr::summarise(gap_score = mean(gap_score, na.rm = TRUE), .groups = "drop") + + message(paste(" ✓ Calculated gap scores for", nrow(gap_scores_df), "fields")) + message(paste(" Gap score range:", round(min(gap_scores_df$gap_score, na.rm=TRUE), 2), "-", round(max(gap_scores_df$gap_score, na.rm=TRUE), 2), "%")) + } else { + message(" WARNING: No gap scores calculated from per-field mosaics") + gap_scores_df <- NULL } # ============================================================================ diff --git a/r_app/80_utils_agronomic_support.R b/r_app/80_utils_agronomic_support.R index 992909c..845be38 100644 --- a/r_app/80_utils_agronomic_support.R +++ b/r_app/80_utils_agronomic_support.R @@ -358,8 +358,6 @@ calculate_weed_presence_kpi <- function(ci_pixels_by_field) { #' @param field_boundaries Field boundaries #' @return List with summary data frame and field-level results data frame calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) { - safe_log("Calculating Gap Filling Score KPI (placeholder)") - # Handle both sf and SpatVector inputs if (!inherits(field_boundaries, "SpatVector")) { field_boundaries_vect <- terra::vect(field_boundaries) diff --git a/r_app/90_CI_report_with_kpis_simple.Rmd b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd similarity index 100% rename from r_app/90_CI_report_with_kpis_simple.Rmd rename to r_app/90_CI_report_with_kpis_agronomic_support.Rmd diff --git a/r_app/91_CI_report_with_kpis_Angata.Rmd b/r_app/91_CI_report_with_kpis_cane_supply.Rmd similarity index 100% rename from r_app/91_CI_report_with_kpis_Angata.Rmd rename to r_app/91_CI_report_with_kpis_cane_supply.Rmd diff --git a/r_app/DEBUG_remove_date_tiffs.R b/r_app/DEBUG_remove_date_tiffs.R index 949d5a3..0b6e165 100644 --- a/r_app/DEBUG_remove_date_tiffs.R +++ b/r_app/DEBUG_remove_date_tiffs.R @@ -102,11 +102,10 @@ main <- function() { error = function(e) NULL ) - if (is.na(date_obj)) { + if (is.null(date_obj) || is.na(date_obj)) { cat(sprintf("[ERROR] Invalid date format: %s (expected YYYY-MM-DD)\n", date_str)) quit(status = 1) - } - + } # =========================================================================== # BUILD LIST OF FOLDERS & FILES TO DELETE # ===========================================================================