276 lines
8.6 KiB
R
276 lines
8.6 KiB
R
# MOSAIC_CREATION_PER_FIELD_UTILS.R
|
|
# ==================================
|
|
# Utility functions for creating per-field weekly mosaics from per-field daily TIFFs.
|
|
#
|
|
# This module aggregates daily per-field 5-band TIFFs (R,G,B,NIR,CI from Script 20)
|
|
# into weekly per-field mosaics using MAX compositing.
|
|
#
|
|
# DATA FLOW:
|
|
# Script 20: field_tiles_CI/{FIELD}/{DATE}.tif (5-band daily, per-field)
|
|
# ↓
|
|
# Script 40 NEW (this module):
|
|
# For each field:
|
|
# For each week:
|
|
# - Find all daily TIFFs for that week
|
|
# - Stack & create MAX composite
|
|
# - Save: weekly_mosaic/{FIELD}/week_WW_YYYY.tif
|
|
# ↓
|
|
# Scripts 90/91: Read weekly_mosaic/{FIELD}/week_WW_YYYY.tif (unchanged interface)
|
|
|
|
#' Safe logging function
|
|
#' @param message The message to log
|
|
#' @param level The log level (default: "INFO")
|
|
#' @return NULL (used for side effects)
|
|
#'
|
|
safe_log <- function(message, level = "INFO") {
|
|
if (exists("log_message")) {
|
|
log_message(message, level)
|
|
} else {
|
|
if (level %in% c("ERROR", "WARNING")) {
|
|
warning(message)
|
|
} else {
|
|
message(message)
|
|
}
|
|
}
|
|
}
|
|
|
|
#' Generate date range for processing (ISO week-based)
|
|
#'
|
|
#' @param end_date The end date (Date object or YYYY-MM-DD string)
|
|
#' @param offset Number of days to look back from end_date (typically 7 for one week)
|
|
#' @return List with week, year, start_date, end_date, days_filter (vector of YYYY-MM-DD strings)
|
|
#'
|
|
date_list <- function(end_date, offset) {
|
|
if (!lubridate::is.Date(end_date)) {
|
|
end_date <- as.Date(end_date)
|
|
if (is.na(end_date)) {
|
|
stop("Invalid end_date. Expected Date object or YYYY-MM-DD string.")
|
|
}
|
|
}
|
|
|
|
offset <- as.numeric(offset)
|
|
if (is.na(offset) || offset < 1) {
|
|
stop("Invalid offset. Expected positive number.")
|
|
}
|
|
|
|
offset <- offset - 1 # Adjust to include end_date
|
|
start_date <- end_date - lubridate::days(offset)
|
|
|
|
week <- lubridate::isoweek(end_date)
|
|
year <- lubridate::isoyear(end_date)
|
|
|
|
days_filter <- seq(from = start_date, to = end_date, by = "day")
|
|
days_filter <- format(days_filter, "%Y-%m-%d")
|
|
|
|
safe_log(paste("Date range:", start_date, "to", end_date,
|
|
"(week", week, "of", year, ")"))
|
|
|
|
return(list(
|
|
week = week,
|
|
year = year,
|
|
start_date = start_date,
|
|
end_date = end_date,
|
|
days_filter = days_filter
|
|
))
|
|
}
|
|
|
|
#' Find all per-field daily TIFFs for a specific week
|
|
#'
|
|
#' @param field_tiles_ci_dir Base directory containing per-field TIFFs
|
|
#' (e.g., field_tiles_CI/)
|
|
#' @param days_filter Vector of YYYY-MM-DD dates to match
|
|
#' @return List with field names and their matching TIFF files for the week
|
|
#'
|
|
find_per_field_tiffs_for_week <- function(field_tiles_ci_dir, days_filter) {
|
|
|
|
if (!dir.exists(field_tiles_ci_dir)) {
|
|
safe_log(paste("Field TIFFs directory not found:", field_tiles_ci_dir), "WARNING")
|
|
return(list())
|
|
}
|
|
|
|
# List all field subdirectories
|
|
field_dirs <- list.dirs(field_tiles_ci_dir, full.names = FALSE, recursive = FALSE)
|
|
|
|
if (length(field_dirs) == 0) {
|
|
safe_log("No field subdirectories found in field_tiles_CI/", "WARNING")
|
|
return(list())
|
|
}
|
|
|
|
# For each field, find TIFF files matching the week's dates
|
|
field_tiffs <- list()
|
|
|
|
for (field in field_dirs) {
|
|
field_path <- file.path(field_tiles_ci_dir, field)
|
|
|
|
# Find all TIFF files in this field directory
|
|
tiff_files <- list.files(field_path, pattern = "\\.tif$", full.names = TRUE)
|
|
|
|
if (length(tiff_files) == 0) {
|
|
next # Skip fields with no TIFFs
|
|
}
|
|
|
|
# Filter to only those matching week's dates
|
|
matching_files <- tiff_files[grepl(paste(days_filter, collapse = "|"), tiff_files)]
|
|
|
|
if (length(matching_files) > 0) {
|
|
field_tiffs[[field]] <- sort(matching_files)
|
|
}
|
|
}
|
|
|
|
safe_log(paste("Found TIFFs for", length(field_tiffs), "fields in week"))
|
|
|
|
return(field_tiffs)
|
|
}
|
|
|
|
#' Create weekly MAX composite for a single field
|
|
#'
|
|
#' Loads all daily TIFFs for a field+week combination and creates a MAX composite
|
|
#' (per-band maximum across all days).
|
|
#'
|
|
#' @param tiff_files Vector of TIFF file paths for this field+week
|
|
#' @param field_name Name of the field (for logging)
|
|
#' @return SpatRaster with 5 bands (R,G,B,NIR,CI), or NULL if fails
|
|
#'
|
|
create_field_weekly_composite <- function(tiff_files, field_name) {
|
|
|
|
if (length(tiff_files) == 0) {
|
|
safe_log(paste("No TIFF files for field:", field_name), "WARNING")
|
|
return(NULL)
|
|
}
|
|
|
|
tryCatch({
|
|
# Load all TIFFs
|
|
rasters <- list()
|
|
for (file in tiff_files) {
|
|
tryCatch({
|
|
r <- terra::rast(file)
|
|
rasters[[length(rasters) + 1]] <- r
|
|
}, error = function(e) {
|
|
safe_log(paste("Warning: Could not load", basename(file), "for field", field_name), "WARNING")
|
|
})
|
|
}
|
|
|
|
if (length(rasters) == 0) {
|
|
safe_log(paste("Failed to load any rasters for field:", field_name), "ERROR")
|
|
return(NULL)
|
|
}
|
|
|
|
# Create MAX composite
|
|
if (length(rasters) == 1) {
|
|
composite <- rasters[[1]]
|
|
safe_log(paste(" Field", field_name, "- single day (no compositing needed)"))
|
|
} else {
|
|
# Stack all rasters and apply MAX per pixel per band
|
|
collection <- terra::sprc(rasters)
|
|
composite <- terra::mosaic(collection, fun = "max")
|
|
safe_log(paste(" Field", field_name, "- MAX composite from", length(rasters), "days"))
|
|
}
|
|
|
|
# Ensure 5 bands with expected names
|
|
if (terra::nlyr(composite) >= 5) {
|
|
composite <- terra::subset(composite, 1:5)
|
|
names(composite) <- c("Red", "Green", "Blue", "NIR", "CI")
|
|
} else {
|
|
safe_log(paste("Warning: Field", field_name, "has", terra::nlyr(composite),
|
|
"bands (expected 5)"), "WARNING")
|
|
}
|
|
|
|
return(composite)
|
|
|
|
}, error = function(e) {
|
|
safe_log(paste("Error creating composite for field", field_name, ":", e$message), "ERROR")
|
|
return(NULL)
|
|
})
|
|
}
|
|
|
|
#' Save per-field weekly mosaic
|
|
#'
|
|
#' @param raster SpatRaster to save
|
|
#' @param output_dir Base output directory (e.g., laravel_app/storage/app/{project}/weekly_mosaic/)
|
|
#' @param field_name Name of the field
|
|
#' @param week Week number (ISO week)
|
|
#' @param year Year (ISO year)
|
|
#' @return File path of saved TIFF, or NULL if fails
|
|
#'
|
|
save_field_weekly_mosaic <- function(raster, output_dir, field_name, week, year) {
|
|
|
|
if (is.null(raster)) {
|
|
return(NULL)
|
|
}
|
|
|
|
tryCatch({
|
|
# Create field-specific output directory
|
|
field_output_dir <- file.path(output_dir, field_name)
|
|
dir.create(field_output_dir, recursive = TRUE, showWarnings = FALSE)
|
|
|
|
# Generate filename: week_WW_YYYY.tif
|
|
filename <- sprintf("week_%02d_%04d.tif", week, year)
|
|
file_path <- file.path(field_output_dir, filename)
|
|
|
|
# Save raster
|
|
terra::writeRaster(raster, file_path, overwrite = TRUE)
|
|
|
|
safe_log(paste(" Saved:", basename(field_output_dir), "/", filename))
|
|
|
|
return(file_path)
|
|
|
|
}, error = function(e) {
|
|
safe_log(paste("Error saving mosaic for field", field_name, ":", e$message), "ERROR")
|
|
return(NULL)
|
|
})
|
|
}
|
|
|
|
#' Create all weekly mosaics for all fields in a week
|
|
#'
|
|
#' Main orchestration function. Loops over all fields and creates weekly mosaics.
|
|
#'
|
|
#' @param dates List from date_list() - contains week, year, days_filter
|
|
#' @param field_tiles_ci_dir Input: field_tiles_CI/ directory
|
|
#' @param output_dir Output: weekly_mosaic/ directory
|
|
#' @return Vector of successfully created file paths
|
|
#'
|
|
create_all_field_weekly_mosaics <- function(dates, field_tiles_ci_dir, output_dir) {
|
|
|
|
safe_log(paste("=== Creating Per-Field Weekly Mosaics ==="))
|
|
safe_log(paste("Week:", dates$week, "Year:", dates$year))
|
|
|
|
# Find all per-field TIFFs for this week
|
|
field_tiffs <- find_per_field_tiffs_for_week(field_tiles_ci_dir, dates$days_filter)
|
|
|
|
if (length(field_tiffs) == 0) {
|
|
safe_log("No per-field TIFFs found for this week - returning empty list", "WARNING")
|
|
return(character())
|
|
}
|
|
|
|
safe_log(paste("Processing", length(field_tiffs), "fields..."))
|
|
|
|
created_files <- character()
|
|
|
|
# Process each field
|
|
for (field_name in names(field_tiffs)) {
|
|
tiff_files <- field_tiffs[[field_name]]
|
|
|
|
# Create composite
|
|
composite <- create_field_weekly_composite(tiff_files, field_name)
|
|
|
|
if (!is.null(composite)) {
|
|
# Save
|
|
saved_path <- save_field_weekly_mosaic(
|
|
composite,
|
|
output_dir,
|
|
field_name,
|
|
dates$week,
|
|
dates$year
|
|
)
|
|
|
|
if (!is.null(saved_path)) {
|
|
created_files <- c(created_files, saved_path)
|
|
}
|
|
}
|
|
}
|
|
|
|
safe_log(paste("✓ Completed: Created", length(created_files), "weekly field mosaics"))
|
|
|
|
return(created_files)
|
|
}
|