SmartCane/r_app/40_mosaic_creation_per_field.R

203 lines
6.6 KiB
R

# ============================================================================
# SCRIPT 40: Weekly Mosaic Creation (Per-Field CI Aggregation)
# ============================================================================
# PURPOSE:
# Aggregate daily per-field CI TIFFs into weekly mosaics. Handles multi-date
# merging, cloud masking, and produces 5-band weekly output for reporting
# and KPI calculations. Supports both per-field and grid-based tile architecture.
#
# INPUT DATA:
# - Source: laravel_app/storage/app/{project}/field_tiles_CI/{FIELD}/{DATE}.tif
# - Format: GeoTIFF (5-band: R,G,B,NIR,CI as float32)
# - Dates: All available dates within week range
#
# OUTPUT DATA:
# - Destination: laravel_app/storage/app/{project}/weekly_mosaic/{FIELD}/
# - Format: GeoTIFF (5-band: R,G,B,NIR,CI)
# - Naming: week_WW_YYYY.tif (WW = ISO week, YYYY = ISO year)
#
# USAGE:
# Rscript 40_mosaic_creation_per_field.R [end_date] [offset] [project]
#
# Example (Windows PowerShell):
# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/40_mosaic_creation_per_field.R 2026-01-12 7 angata
#
# PARAMETERS:
# - end_date: End date for processing (character, YYYY-MM-DD format, default today)
# - offset: Days to look back (numeric, default 7 for one week)
# - project: Project name (character) - angata, chemba, xinavane, esa, simba
#
# CLIENT TYPES:
# - cane_supply (ANGATA): Yes - weekly monitoring
# - agronomic_support (AURA): Yes - field health reporting
#
# DEPENDENCIES:
# - Packages: terra, sf, tidyverse, lubridate
# - Utils files: parameters_project.R, 40_mosaic_creation_per_field_utils.R
# - Input data: Daily per-field CI TIFFs from Script 20
# - Data directories: field_tiles_CI/, weekly_mosaic/
#
# NOTES:
# - Aggregation method: Maximum CI value per pixel across week (handles clouds)
# - ISO week-year used for consistent date handling across year boundaries
# - Supports both single-file and tiled mosaic architectures
# - Output feeds Scripts 80 (KPI calculations) and 90/91 (reporting)
# - Critical for trend analysis: week-over-week CI comparison
#
# RELATED ISSUES:
# SC-112: Script 40 cleanup (deleted legacy mosaic utils files)
# SC-108: Core pipeline improvements
#
# ============================================================================
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(here)
})
# 2. Main execution function
# -------------------------
main <- function() {
cat("\n")
cat("========================================================\n")
cat(" Script 40: Per-Field Weekly Mosaic Creation\n")
cat("========================================================\n\n")
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# ==== Process Arguments ====
# Project directory
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else if (exists("project_dir", envir = .GlobalEnv)) {
project_dir <- get("project_dir", envir = .GlobalEnv)
} else {
project_dir <- "angata"
message("[INFO] No project_dir provided. Using default: angata")
}
assign("project_dir", project_dir, envir = .GlobalEnv)
message(paste("[INFO] Project:", project_dir))
# End date
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1], format = "%Y-%m-%d")
if (is.na(end_date)) {
message("[WARNING] Invalid end_date. Using current date.")
end_date <- Sys.Date()
}
} else {
end_date <- Sys.Date()
message(paste("[INFO] No end_date provided. Using current date:", format(end_date)))
}
# Offset (days back)
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
message("[WARNING] Invalid offset. Using default: 7 days")
offset <- 7
}
} else {
offset <- 7
message("[INFO] No offset provided. Using default: 7 days")
}
# ==== Load Configuration ====
# Set working directory if needed
if (basename(getwd()) == "r_app") {
setwd("..")
}
tryCatch({
source("r_app/parameters_project.R")
message("[INFO] ✓ Loaded parameters_project.R")
}, error = function(e) {
stop("[ERROR] Failed to load parameters_project.R: ", e$message)
})
tryCatch({
source("r_app/40_mosaic_creation_per_field_utils.R")
message("[INFO] ✓ Loaded 40_mosaic_creation_per_field_utils.R")
}, error = function(e) {
stop("[ERROR] Failed to load utilities: ", e$message)
})
# ==== Get Project Directories ====
setup <- setup_project_directories(project_dir)
# Determine input/output directories
# Input: field_tiles_CI/ (from Script 20)
field_tiles_ci_dir <- setup$field_tiles_ci_dir
# Output: weekly_mosaic/ (for Scripts 90/91)
weekly_mosaic_output_dir <- file.path(setup$laravel_storage_dir, "weekly_mosaic")
message(paste("[INFO] Input directory:", field_tiles_ci_dir))
message(paste("[INFO] Output directory:", weekly_mosaic_output_dir))
# ==== Validate Input Directory ====
if (!dir.exists(field_tiles_ci_dir)) {
stop(paste("[ERROR] Input directory not found:", field_tiles_ci_dir,
"\nScript 20 (CI extraction) must be run first to create per-field TIFFs."))
}
# Check if directory has any TIFFs
field_dirs <- list.dirs(field_tiles_ci_dir, full.names = FALSE, recursive = FALSE)
if (length(field_dirs) == 0) {
stop(paste("[ERROR] No field subdirectories found in:", field_tiles_ci_dir))
}
message(paste("[INFO] Found", length(field_dirs), "field directories"))
# ==== Generate Date Range ====
dates <- date_list(end_date, offset)
# ==== Create Per-Field Weekly Mosaics ====
created_files <- create_all_field_weekly_mosaics(
dates = dates,
field_tiles_ci_dir = field_tiles_ci_dir,
output_dir = weekly_mosaic_output_dir
)
# ==== Summary ====
message("\n")
message("========================================================")
message(paste(" COMPLETED"))
message(paste(" Created:", length(created_files), "weekly field mosaics"))
message("========================================================\n")
if (length(created_files) > 0) {
message("[SUCCESS] Weekly mosaics ready for reporting (Scripts 90/91)")
} else {
message("[WARNING] No mosaics created - check input data")
}
return(invisible(created_files))
}
# Execute main if script is run directly
if (sys.nframe() == 0) {
tryCatch({
created <- main()
quit(save = "no", status = 0)
}, error = function(e) {
message(paste("\n[FATAL ERROR]", e$message))
quit(save = "no", status = 1)
})
}