gap filling worked to per-field

r_app/80_calculate_kpis.R

@@ -598,128 +598,70 @@ 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)
+  
+    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_))
+      }
   
-    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)
+        field_raster <- terra::rast(field_file)
         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 = ", ")))
+        if (!(ci_band_name %in% names(field_raster))) {
+          return(data.frame(Field_id = field_id, gap_score = NA_real_))
         }
-        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 = ", ")))
+        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_))
         }
-        current_ci_band <- current_week_raster[[ci_band_name]]
-        names(current_ci_band) <- "CI"
   
-        message(paste("  Loaded single mosaic:", week_mosaic_file))
+        gap_scores <- gap_result$field_results
+        gap_scores$Field_id <- gap_scores$field
+        gap_scores <- gap_scores[, c("Field_id", "gap_score")]
   
-        # Calculate gap scores for all fields
-        gap_result <- calculate_gap_filling_kpi(current_ci_band, field_boundaries_sf)
+        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_)
+      })
+    }
   
-        # 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)
+    # 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), "%"))
-      
-      }, 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")
+      message("  WARNING: No gap scores calculated from per-field mosaics")
       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
-        })
-      }
-    }
-  
     # ============================================================================
     # Build final output dataframe with all 22 columns (including Gap_score)
     # ============================================================================

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)

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
   # ===========================================================================