435 lines
16 KiB
R
435 lines
16 KiB
R
# MOSAIC_CREATION_UTILS.R
|
|
# ======================
|
|
# Utility functions for creating weekly mosaics from daily satellite imagery.
|
|
# These functions support cloud cover assessment, date handling, and mosaic creation.
|
|
|
|
#' 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 a sequence of dates for processing
|
|
#'
|
|
#' @param end_date The end date for the sequence (Date object)
|
|
#' @param offset Number of days to look back from end_date
|
|
#' @return A list containing week number, year, and a sequence of dates for filtering
|
|
#'
|
|
date_list <- function(end_date, offset) {
|
|
# Input validation
|
|
if (!lubridate::is.Date(end_date)) {
|
|
end_date <- as.Date(end_date)
|
|
if (is.na(end_date)) {
|
|
stop("Invalid end_date provided. Expected a Date object or a string convertible to Date.")
|
|
}
|
|
}
|
|
|
|
offset <- as.numeric(offset)
|
|
if (is.na(offset) || offset < 1) {
|
|
stop("Invalid offset provided. Expected a positive number.")
|
|
}
|
|
|
|
# Calculate date range
|
|
offset <- offset - 1 # Adjust offset to include end_date
|
|
start_date <- end_date - lubridate::days(offset)
|
|
|
|
# Extract week and year information
|
|
week <- lubridate::isoweek(end_date)
|
|
year <- lubridate::isoyear(end_date)
|
|
|
|
# Generate sequence of dates
|
|
days_filter <- seq(from = start_date, to = end_date, by = "day")
|
|
days_filter <- format(days_filter, "%Y-%m-%d") # Format for consistent filtering
|
|
|
|
# Log the date range
|
|
safe_log(paste("Date range generated from", start_date, "to", end_date))
|
|
|
|
return(list(
|
|
"week" = week,
|
|
"year" = year,
|
|
"days_filter" = days_filter,
|
|
"start_date" = start_date,
|
|
"end_date" = end_date
|
|
))
|
|
}
|
|
|
|
#' Create a weekly mosaic from available VRT files
|
|
#'
|
|
#' @param dates List from date_list() with date range info
|
|
#' @param field_boundaries Field boundaries for image cropping
|
|
#' @param daily_vrt_dir Directory containing VRT files
|
|
#' @param merged_final_dir Directory with merged final rasters
|
|
#' @param output_dir Output directory for weekly mosaics
|
|
#' @param file_name_tif Output filename for the mosaic
|
|
#' @param create_plots Whether to create visualization plots (default: TRUE)
|
|
#' @return The file path of the saved mosaic
|
|
#'
|
|
create_weekly_mosaic <- function(dates, field_boundaries, daily_vrt_dir,
|
|
merged_final_dir, output_dir, file_name_tif,
|
|
create_plots = FALSE) {
|
|
# Find VRT files for the specified date range
|
|
vrt_list <- find_vrt_files(daily_vrt_dir, dates)
|
|
|
|
# Find final raster files for fallback
|
|
raster_files_final <- list.files(merged_final_dir, full.names = TRUE, pattern = "\\.tif$")
|
|
|
|
# Process the mosaic if VRT files are available
|
|
if (length(vrt_list) > 0) {
|
|
safe_log("VRT list created, assessing cloud cover for mosaic creation")
|
|
|
|
# Calculate aggregated cloud cover statistics (returns data frame for image selection)
|
|
cloud_coverage_stats <- count_cloud_coverage(vrt_list, merged_final_dir)
|
|
|
|
# Create mosaic based on cloud cover assessment
|
|
mosaic <- create_mosaic(raster_files_final, cloud_coverage_stats, field_boundaries)
|
|
|
|
} else {
|
|
safe_log("No VRT files available for the date range, creating empty mosaic with NA values", "WARNING")
|
|
|
|
# Create empty mosaic if no files are available
|
|
if (length(raster_files_final) == 0) {
|
|
stop("No VRT files or final raster files available to create mosaic")
|
|
}
|
|
|
|
mosaic <- terra::rast(raster_files_final[1])
|
|
mosaic <- terra::setValues(mosaic, NA)
|
|
mosaic <- terra::crop(mosaic, field_boundaries, mask = TRUE)
|
|
|
|
names(mosaic) <- c("Red", "Green", "Blue", "NIR", "CI")
|
|
}
|
|
|
|
# Save the mosaic (without mask files to avoid breaking other scripts)
|
|
file_path <- save_mosaic(mosaic, output_dir, file_name_tif, create_plots, save_mask = FALSE)
|
|
|
|
safe_log(paste("Weekly mosaic processing completed for week", dates$week))
|
|
|
|
return(file_path)
|
|
}
|
|
|
|
#' Find VRT files within a date range
|
|
#'
|
|
#' @param vrt_directory Directory containing VRT files
|
|
#' @param dates List from date_list() function containing days_filter
|
|
#' @return Character vector of VRT file paths
|
|
#'
|
|
find_vrt_files <- function(vrt_directory, dates) {
|
|
# Get all VRT files in directory
|
|
vrt_files <- list.files(here::here(vrt_directory), full.names = TRUE)
|
|
|
|
if (length(vrt_files) == 0) {
|
|
warning("No VRT files found in directory: ", vrt_directory)
|
|
return(character(0))
|
|
}
|
|
|
|
# Filter files by dates
|
|
vrt_list <- purrr::map(dates$days_filter, ~ vrt_files[grepl(pattern = .x, x = vrt_files)]) %>%
|
|
purrr::compact() %>%
|
|
purrr::flatten_chr()
|
|
|
|
# Log results
|
|
safe_log(paste("Found", length(vrt_list), "VRT files for the date range"))
|
|
|
|
return(vrt_list)
|
|
}
|
|
|
|
#' Count missing pixels (clouds) in rasters - per field analysis using actual TIF files
|
|
#'
|
|
#' @param vrt_list List of VRT file paths (used to extract dates for TIF file lookup)
|
|
#' @param merged_final_dir Directory containing the actual TIF files (e.g., merged_final_tif)
|
|
#' @return Data frame with aggregated cloud statistics for each TIF file (used for mosaic selection)
|
|
#'
|
|
count_cloud_coverage <- function(vrt_list, merged_final_dir = NULL) {
|
|
if (length(vrt_list) == 0) {
|
|
warning("No VRT files provided for cloud coverage calculation")
|
|
return(NULL)
|
|
}
|
|
|
|
tryCatch({
|
|
# Extract dates from VRT filenames to find corresponding TIF files
|
|
# VRT filenames are like "merged2025-12-18.vrt", TIF filenames are like "2025-12-18.tif"
|
|
tif_dates <- gsub(".*([0-9]{4}-[0-9]{2}-[0-9]{2}).*", "\\1", basename(vrt_list))
|
|
|
|
# Build list of actual TIF files to use
|
|
tif_files <- paste0(here::here(merged_final_dir), "/", tif_dates, ".tif")
|
|
|
|
# Check which TIF files exist
|
|
tif_exist <- file.exists(tif_files)
|
|
if (!any(tif_exist)) {
|
|
warning("No TIF files found in directory: ", merged_final_dir)
|
|
return(NULL)
|
|
}
|
|
|
|
tif_files <- tif_files[tif_exist]
|
|
safe_log(paste("Found", length(tif_files), "TIF files for cloud coverage assessment"))
|
|
|
|
# Initialize list to store aggregated results
|
|
aggregated_results <- list()
|
|
|
|
# Process each TIF file
|
|
for (tif_idx in seq_along(tif_files)) {
|
|
tif_file <- tif_files[tif_idx]
|
|
|
|
tryCatch({
|
|
# Load the TIF file (typically has 5 bands: R, G, B, NIR, CI)
|
|
current_raster <- terra::rast(tif_file)
|
|
|
|
# Extract the CI band (last band)
|
|
ci_band <- current_raster[[terra::nlyr(current_raster)]]
|
|
|
|
# Count notNA pixels across entire raster
|
|
total_notna <- terra::global(ci_band, fun = "notNA")$notNA
|
|
total_pixels <- terra::ncell(ci_band)
|
|
|
|
# Calculate cloud coverage percentage (missing = clouds)
|
|
missing_pct <- round(100 - ((total_notna / total_pixels) * 100))
|
|
|
|
aggregated_results[[tif_idx]] <- data.frame(
|
|
filename = tif_file,
|
|
notNA = total_notna,
|
|
total_pixels = total_pixels,
|
|
missing_pixels_percentage = missing_pct,
|
|
thres_5perc = as.integer(missing_pct < 5),
|
|
thres_40perc = as.integer(missing_pct < 45),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
}, error = function(e) {
|
|
safe_log(paste("Error processing TIF", basename(tif_file), ":", e$message), "WARNING")
|
|
aggregated_results[[tif_idx]] <<- data.frame(
|
|
filename = tif_file,
|
|
notNA = NA_real_,
|
|
total_pixels = NA_real_,
|
|
missing_pixels_percentage = 100,
|
|
thres_5perc = 0,
|
|
thres_40perc = 0,
|
|
stringsAsFactors = FALSE
|
|
)
|
|
})
|
|
}
|
|
|
|
# Combine all aggregated results
|
|
aggregated_df <- if (length(aggregated_results) > 0) {
|
|
do.call(rbind, aggregated_results)
|
|
} else {
|
|
data.frame()
|
|
}
|
|
|
|
# Log results
|
|
safe_log(paste("Cloud coverage assessment completed for", length(vrt_list), "images"))
|
|
|
|
# Return aggregated data only
|
|
return(aggregated_df)
|
|
|
|
}, error = function(e) {
|
|
warning("Error in cloud coverage calculation: ", e$message)
|
|
return(NULL)
|
|
})
|
|
}
|
|
|
|
#' Create a mosaic from merged_final_tif files based on cloud coverage
|
|
#'
|
|
#' @param tif_files List of processed TIF files (5 bands: R, G, B, NIR, CI)
|
|
#' @param cloud_coverage_stats Cloud coverage statistics from count_cloud_coverage()
|
|
#' @param field_boundaries Field boundaries for masking (optional)
|
|
#' @return A SpatRaster object with 5 bands (Red, Green, Blue, NIR, CI)
|
|
#'
|
|
create_mosaic <- function(tif_files, cloud_coverage_stats, field_boundaries = NULL) {
|
|
# If no TIF files, return NULL
|
|
if (length(tif_files) == 0) {
|
|
safe_log("No TIF files available for mosaic creation", "ERROR")
|
|
return(NULL)
|
|
}
|
|
|
|
# Validate cloud coverage stats
|
|
mosaic_type <- "Unknown" # Track what type of mosaic is being created
|
|
|
|
if (is.null(cloud_coverage_stats) || nrow(cloud_coverage_stats) == 0) {
|
|
safe_log("No cloud coverage statistics available, using all files", "WARNING")
|
|
rasters_to_use <- tif_files
|
|
mosaic_type <- paste("all", length(tif_files), "available images")
|
|
} else {
|
|
# Determine best rasters to use based on cloud coverage thresholds
|
|
# Count how many images meet each threshold
|
|
num_5perc <- sum(cloud_coverage_stats$thres_5perc, na.rm = TRUE)
|
|
num_40perc <- sum(cloud_coverage_stats$thres_40perc, na.rm = TRUE)
|
|
|
|
if (num_5perc > 1) {
|
|
# Multiple images with <5% cloud coverage
|
|
safe_log(paste("Creating max composite from", num_5perc, "cloud-free images (<5% clouds)"))
|
|
mosaic_type <- paste(num_5perc, "cloud-free images (<5% clouds)")
|
|
best_coverage <- which(cloud_coverage_stats$thres_5perc > 0)
|
|
|
|
} else if (num_5perc == 1) {
|
|
# Single image with <5% cloud coverage
|
|
safe_log("Using single cloud-free image (<5% clouds)")
|
|
mosaic_type <- "single cloud-free image (<5% clouds)"
|
|
best_coverage <- which(cloud_coverage_stats$thres_5perc > 0)
|
|
|
|
} else if (num_40perc > 1) {
|
|
# Multiple images with <40% cloud coverage
|
|
safe_log(paste("Creating max composite from", num_40perc, "partially cloudy images (<40% clouds)"), "WARNING")
|
|
mosaic_type <- paste(num_40perc, "partially cloudy images (<40% clouds)")
|
|
best_coverage <- which(cloud_coverage_stats$thres_40perc > 0)
|
|
|
|
} else if (num_40perc == 1) {
|
|
# Single image with <40% cloud coverage
|
|
safe_log("Using single partially cloudy image (<40% clouds)", "WARNING")
|
|
mosaic_type <- "single partially cloudy image (<40% clouds)"
|
|
best_coverage <- which(cloud_coverage_stats$thres_40perc > 0)
|
|
|
|
} else {
|
|
# No cloud-free images available
|
|
safe_log("No cloud-free images available, using all images", "WARNING")
|
|
mosaic_type <- paste("all", nrow(cloud_coverage_stats), "available images")
|
|
best_coverage <- seq_len(nrow(cloud_coverage_stats))
|
|
}
|
|
|
|
# Get filenames of best-coverage images
|
|
# Match by finding filenames that match the dates in cloud_coverage_stats
|
|
rasters_to_use <- character()
|
|
for (idx in best_coverage) {
|
|
# Extract date from cloud_coverage_stats filename
|
|
cc_filename <- cloud_coverage_stats$filename[idx]
|
|
# Find matching TIF file
|
|
matching_tif <- tif_files[grepl(basename(cc_filename), basename(tif_files), fixed = TRUE)]
|
|
if (length(matching_tif) > 0) {
|
|
rasters_to_use <- c(rasters_to_use, matching_tif[1])
|
|
}
|
|
}
|
|
|
|
if (length(rasters_to_use) == 0) {
|
|
safe_log("Could not match cloud coverage stats to TIF files, using all files", "WARNING")
|
|
rasters_to_use <- tif_files
|
|
mosaic_type <- paste("all", length(tif_files), "available images")
|
|
}
|
|
}
|
|
|
|
# Load and mosaic the selected rasters
|
|
if (length(rasters_to_use) == 1) {
|
|
# Single file - just load it
|
|
safe_log(paste("Using single image for mosaic:", basename(rasters_to_use)))
|
|
mosaic <- terra::rast(rasters_to_use[1])
|
|
} else {
|
|
# Multiple files - create mosaic using max function
|
|
safe_log(paste("Creating mosaic from", length(rasters_to_use), "images"))
|
|
rsrc <- terra::sprc(rasters_to_use)
|
|
mosaic <- terra::mosaic(rsrc, fun = "max")
|
|
}
|
|
|
|
# Ensure we have exactly 5 bands (R, G, B, NIR, CI)
|
|
if (terra::nlyr(mosaic) != 5) {
|
|
safe_log(paste("Warning: mosaic has", terra::nlyr(mosaic), "bands, expected 5"), "WARNING")
|
|
if (terra::nlyr(mosaic) > 5) {
|
|
# Keep only first 5 bands
|
|
mosaic <- terra::subset(mosaic, 1:5)
|
|
safe_log("Keeping only first 5 bands")
|
|
}
|
|
}
|
|
|
|
|
|
|
|
# Crop/mask to field boundaries if provided
|
|
if (!is.null(field_boundaries)) {
|
|
tryCatch({
|
|
mosaic <- terra::crop(mosaic, field_boundaries, mask = TRUE)
|
|
safe_log("Mosaic cropped to field boundaries")
|
|
}, error = function(e) {
|
|
safe_log(paste("Could not crop to field boundaries:", e$message), "WARNING")
|
|
# Return uncropped mosaic
|
|
})
|
|
}
|
|
|
|
# Log final mosaic summary
|
|
safe_log(paste("✓ Mosaic created from", mosaic_type, "-", terra::nlyr(mosaic),
|
|
"bands,", nrow(mosaic), "x", ncol(mosaic), "pixels"))
|
|
|
|
return(mosaic)
|
|
}
|
|
|
|
#' Save a mosaic raster to disk
|
|
#'
|
|
#' @param mosaic_raster A SpatRaster object to save
|
|
#' @param output_dir Directory to save the output
|
|
#' @param file_name Filename for the output raster
|
|
#' @param plot_result Whether to create visualizations (default: FALSE)
|
|
#' @param save_mask Whether to save cloud masks separately (default: FALSE)
|
|
#' @return The file path of the saved raster
|
|
#'
|
|
save_mosaic <- function(mosaic_raster, output_dir, file_name, plot_result = FALSE, save_mask = FALSE) {
|
|
# Validate input
|
|
if (is.null(mosaic_raster)) {
|
|
stop("No mosaic raster provided to save")
|
|
}
|
|
|
|
# Create output directory if it doesn't exist
|
|
dir.create(output_dir, recursive = TRUE, showWarnings = FALSE)
|
|
|
|
# Create full file path
|
|
file_path <- here::here(output_dir, file_name)
|
|
|
|
# Get cloud mask if it exists
|
|
cloud_mask <- attr(mosaic_raster, "cloud_mask")
|
|
|
|
# Save raster
|
|
terra::writeRaster(mosaic_raster, file_path, overwrite = TRUE)
|
|
|
|
# Save cloud mask if available and requested
|
|
if (!is.null(cloud_mask) && save_mask) {
|
|
# Create mask filename by adding _mask before extension
|
|
mask_file_name <- gsub("\\.(tif|TIF)$", "_mask.\\1", file_name)
|
|
mask_file_path <- here::here(output_dir, mask_file_name)
|
|
|
|
# Save the mask
|
|
terra::writeRaster(cloud_mask, mask_file_path, overwrite = TRUE)
|
|
safe_log(paste("Cloud/shadow mask saved to:", mask_file_path))
|
|
} else if (!is.null(cloud_mask)) {
|
|
safe_log("Cloud mask available but not saved (save_mask = FALSE)")
|
|
}
|
|
|
|
# Create plots if requested
|
|
if (plot_result) {
|
|
# Plot the CI band
|
|
if ("CI" %in% names(mosaic_raster)) {
|
|
terra::plot(mosaic_raster$CI, main = paste("CI map", file_name))
|
|
}
|
|
|
|
# Plot RGB image
|
|
if (all(c("Red", "Green", "Blue") %in% names(mosaic_raster))) {
|
|
terra::plotRGB(mosaic_raster, main = paste("RGB map", file_name))
|
|
}
|
|
|
|
# Plot cloud mask if available
|
|
if (!is.null(cloud_mask)) {
|
|
terra::plot(cloud_mask, main = paste("Cloud/shadow mask", file_name),
|
|
col = c("red", "green"))
|
|
}
|
|
|
|
# If we have both RGB and cloud mask, create a side-by-side comparison
|
|
if (all(c("Red", "Green", "Blue") %in% names(mosaic_raster)) && !is.null(cloud_mask)) {
|
|
old_par <- par(mfrow = c(1, 2))
|
|
terra::plotRGB(mosaic_raster, main = "RGB Image")
|
|
|
|
# Create a colored mask for visualization (red = cloud/shadow, green = clear)
|
|
mask_plot <- cloud_mask
|
|
terra::plot(mask_plot, main = "Cloud/Shadow Mask", col = c("red", "green"))
|
|
par(old_par)
|
|
}
|
|
}
|
|
|
|
# Log save completion
|
|
safe_log(paste("Mosaic saved to:", file_path))
|
|
|
|
return(file_path)
|
|
}
|