gap filling worked to per-field
This commit is contained in:
parent
054cc85bdb
commit
b1b96e6c6a
|
|
@ -598,126 +598,68 @@ main <- function() {
|
||||||
|
|
||||||
message("\nCalculating gap filling scores (2σ method)...")
|
message("\nCalculating gap filling scores (2σ method)...")
|
||||||
|
|
||||||
# Try single merged mosaic first, then fall back to merging tiles
|
# Process per-field mosaics
|
||||||
week_mosaic_file <- file.path(mosaic_dir, sprintf("week_%02d_%d.tif", current_week, current_year))
|
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)) {
|
process_gap_for_field <- function(field_file) {
|
||||||
# Single merged mosaic exists - use it directly
|
field_id <- basename(dirname(field_file))
|
||||||
tryCatch({
|
field_bounds <- field_boundaries_by_id[[field_id]]
|
||||||
current_week_raster <- terra::rast(week_mosaic_file)
|
|
||||||
# Extract CI band by name (not assumed position)
|
if (is.null(field_bounds) || nrow(field_bounds) == 0) {
|
||||||
# Extract CI band (5th band in mosaic)
|
return(data.frame(Field_id = field_id, gap_score = NA_real_))
|
||||||
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
|
|
||||||
})
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
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
|
||||||
}
|
}
|
||||||
|
|
||||||
# ============================================================================
|
# ============================================================================
|
||||||
|
|
|
||||||
|
|
@ -358,8 +358,6 @@ calculate_weed_presence_kpi <- function(ci_pixels_by_field) {
|
||||||
#' @param field_boundaries Field boundaries
|
#' @param field_boundaries Field boundaries
|
||||||
#' @return List with summary data frame and field-level results data frame
|
#' @return List with summary data frame and field-level results data frame
|
||||||
calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
||||||
safe_log("Calculating Gap Filling Score KPI (placeholder)")
|
|
||||||
|
|
||||||
# Handle both sf and SpatVector inputs
|
# Handle both sf and SpatVector inputs
|
||||||
if (!inherits(field_boundaries, "SpatVector")) {
|
if (!inherits(field_boundaries, "SpatVector")) {
|
||||||
field_boundaries_vect <- terra::vect(field_boundaries)
|
field_boundaries_vect <- terra::vect(field_boundaries)
|
||||||
|
|
|
||||||
|
|
@ -102,11 +102,10 @@ main <- function() {
|
||||||
error = function(e) NULL
|
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))
|
cat(sprintf("[ERROR] Invalid date format: %s (expected YYYY-MM-DD)\n", date_str))
|
||||||
quit(status = 1)
|
quit(status = 1)
|
||||||
}
|
}
|
||||||
|
|
||||||
# ===========================================================================
|
# ===========================================================================
|
||||||
# BUILD LIST OF FOLDERS & FILES TO DELETE
|
# BUILD LIST OF FOLDERS & FILES TO DELETE
|
||||||
# ===========================================================================
|
# ===========================================================================
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue