Changed the week and year numbering to use ISO in the kpi_utils. Update the 80 script to call the function.
This commit is contained in:
parent
9f217df98a
commit
cc38d25a54
|
|
@ -175,9 +175,6 @@ STATUS_TRIGGERS <- data.frame(
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
# ============================================================================
|
|
||||||
# MAIN
|
|
||||||
# ============================================================================
|
|
||||||
|
|
||||||
# ============================================================================
|
# ============================================================================
|
||||||
# MAIN
|
# MAIN
|
||||||
|
|
@ -260,16 +257,18 @@ main <- function() {
|
||||||
message("PHASE 1: PER-FIELD WEEKLY ANALYSIS (SC-64 ENHANCEMENTS)")
|
message("PHASE 1: PER-FIELD WEEKLY ANALYSIS (SC-64 ENHANCEMENTS)")
|
||||||
message(strrep("-", 70))
|
message(strrep("-", 70))
|
||||||
|
|
||||||
current_week <- as.numeric(format(end_date, "%V"))
|
# Calculate ISO week numbers and ISO years using helper from kpi_utils.R
|
||||||
year <- as.numeric(format(end_date, "%Y"))
|
weeks <- calculate_week_numbers(end_date)
|
||||||
previous_week <- current_week - 1
|
current_week <- weeks$current_week
|
||||||
if (previous_week < 1) previous_week <- 52
|
current_iso_year <- weeks$current_iso_year
|
||||||
|
previous_week <- weeks$previous_week
|
||||||
|
previous_iso_year <- weeks$previous_iso_year
|
||||||
|
|
||||||
message(paste("Week:", current_week, "/ Year:", year))
|
message(paste("Week:", current_week, "/ ISO Year:", current_iso_year))
|
||||||
|
|
||||||
# Find tile files - approach from Script 20
|
# Find tile files - approach from Script 20
|
||||||
message("Finding tile files...")
|
message("Finding tile files...")
|
||||||
tile_pattern <- sprintf("week_%02d_%d_([0-9]{2})\\.tif", current_week, year)
|
tile_pattern <- sprintf("week_%02d_%d_([0-9]{2})\\.tif", current_week, current_iso_year)
|
||||||
|
|
||||||
# Detect grid size subdirectory
|
# Detect grid size subdirectory
|
||||||
detected_grid_size <- NA
|
detected_grid_size <- NA
|
||||||
|
|
@ -285,7 +284,7 @@ main <- function() {
|
||||||
|
|
||||||
tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE)
|
tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE)
|
||||||
if (length(tile_files) == 0) {
|
if (length(tile_files) == 0) {
|
||||||
stop(paste("No tile files found for week", current_week, year, "in", mosaic_dir))
|
stop(paste("No tile files found for week", current_week, current_iso_year, "in", mosaic_dir))
|
||||||
}
|
}
|
||||||
message(paste(" Found", length(tile_files), "tiles"))
|
message(paste(" Found", length(tile_files), "tiles"))
|
||||||
|
|
||||||
|
|
@ -361,7 +360,7 @@ main <- function() {
|
||||||
|
|
||||||
# Build tile grid (needed by calculate_field_statistics)
|
# Build tile grid (needed by calculate_field_statistics)
|
||||||
message("\nBuilding tile grid for current week...")
|
message("\nBuilding tile grid for current week...")
|
||||||
tile_grid <- build_tile_grid(mosaic_dir, current_week, year)
|
tile_grid <- build_tile_grid(mosaic_dir, current_week, current_iso_year)
|
||||||
|
|
||||||
message("\nUsing modular RDS-based approach for weekly statistics...")
|
message("\nUsing modular RDS-based approach for weekly statistics...")
|
||||||
|
|
||||||
|
|
@ -369,7 +368,7 @@ main <- function() {
|
||||||
message("\n1. Loading/calculating CURRENT week statistics (week", current_week, ")...")
|
message("\n1. Loading/calculating CURRENT week statistics (week", current_week, ")...")
|
||||||
current_stats <- load_or_calculate_weekly_stats(
|
current_stats <- load_or_calculate_weekly_stats(
|
||||||
week_num = current_week,
|
week_num = current_week,
|
||||||
year = year,
|
year = current_iso_year,
|
||||||
project_dir = project_dir,
|
project_dir = project_dir,
|
||||||
field_boundaries_sf = field_boundaries_sf,
|
field_boundaries_sf = field_boundaries_sf,
|
||||||
mosaic_dir = tile_grid$mosaic_dir,
|
mosaic_dir = tile_grid$mosaic_dir,
|
||||||
|
|
@ -387,7 +386,7 @@ main <- function() {
|
||||||
|
|
||||||
prev_stats <- load_or_calculate_weekly_stats(
|
prev_stats <- load_or_calculate_weekly_stats(
|
||||||
week_num = previous_week,
|
week_num = previous_week,
|
||||||
year = year,
|
year = previous_iso_year,
|
||||||
project_dir = project_dir,
|
project_dir = project_dir,
|
||||||
field_boundaries_sf = field_boundaries_sf,
|
field_boundaries_sf = field_boundaries_sf,
|
||||||
mosaic_dir = tile_grid$mosaic_dir,
|
mosaic_dir = tile_grid$mosaic_dir,
|
||||||
|
|
@ -405,14 +404,14 @@ main <- function() {
|
||||||
project_dir = project_dir,
|
project_dir = project_dir,
|
||||||
reports_dir = reports_dir,
|
reports_dir = reports_dir,
|
||||||
current_week = current_week,
|
current_week = current_week,
|
||||||
year = year)
|
year = current_iso_year)
|
||||||
|
|
||||||
message(paste(" ✓ Added Weekly_ci_change, CV_Trend_Short_Term, Four_week_trend, CV_Trend_Long_Term, nmr_of_weeks_analysed"))
|
message(paste(" ✓ Added Weekly_ci_change, CV_Trend_Short_Term, Four_week_trend, CV_Trend_Long_Term, nmr_of_weeks_analysed"))
|
||||||
|
|
||||||
# Load weekly harvest probabilities from script 31 (if available)
|
# Load weekly harvest probabilities from script 31 (if available)
|
||||||
message("\n4. Loading harvest probabilities from script 31...")
|
message("\n4. Loading harvest probabilities from script 31...")
|
||||||
harvest_prob_file <- file.path(reports_dir, "kpis", "field_stats",
|
harvest_prob_file <- file.path(reports_dir, "kpis", "field_stats",
|
||||||
sprintf("%s_harvest_imminent_week_%02d_%d.csv", project_dir, current_week, year))
|
sprintf("%s_harvest_imminent_week_%02d_%d.csv", project_dir, current_week, current_iso_year))
|
||||||
message(paste(" Looking for:", harvest_prob_file))
|
message(paste(" Looking for:", harvest_prob_file))
|
||||||
|
|
||||||
imminent_prob_data <- tryCatch({
|
imminent_prob_data <- tryCatch({
|
||||||
|
|
@ -438,7 +437,7 @@ 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
|
# 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, year))
|
week_mosaic_file <- file.path(mosaic_dir, sprintf("week_%02d_%d.tif", current_week, current_iso_year))
|
||||||
|
|
||||||
gap_scores_df <- NULL
|
gap_scores_df <- NULL
|
||||||
|
|
||||||
|
|
@ -473,7 +472,7 @@ main <- function() {
|
||||||
message(" Single mosaic not found. Checking for tiles...")
|
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)
|
# 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, year)
|
tile_pattern <- sprintf("week_%02d_%d_\\d{2}\\.tif$", current_week, current_iso_year)
|
||||||
tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE)
|
tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE)
|
||||||
|
|
||||||
if (length(tile_files) == 0) {
|
if (length(tile_files) == 0) {
|
||||||
|
|
@ -739,7 +738,7 @@ main <- function() {
|
||||||
NULL,
|
NULL,
|
||||||
project_dir,
|
project_dir,
|
||||||
current_week,
|
current_week,
|
||||||
year,
|
current_iso_year,
|
||||||
reports_dir
|
reports_dir
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -810,7 +809,7 @@ main <- function() {
|
||||||
median_ci = round(median(field_data$Mean_CI, na.rm = TRUE), 2),
|
median_ci = round(median(field_data$Mean_CI, na.rm = TRUE), 2),
|
||||||
mean_cv = round(mean(field_data$CI_CV, na.rm = TRUE), 4),
|
mean_cv = round(mean(field_data$CI_CV, na.rm = TRUE), 4),
|
||||||
week = current_week,
|
week = current_week,
|
||||||
year = year,
|
year = current_iso_year,
|
||||||
date = as.character(end_date)
|
date = as.character(end_date)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -41,19 +41,26 @@ extract_ci_values <- function(ci_raster, field_vect) {
|
||||||
#' @param report_date Date to calculate weeks for (default: today)
|
#' @param report_date Date to calculate weeks for (default: today)
|
||||||
#' @return List with current_week and previous_week numbers
|
#' @return List with current_week and previous_week numbers
|
||||||
calculate_week_numbers <- function(report_date = Sys.Date()) {
|
calculate_week_numbers <- function(report_date = Sys.Date()) {
|
||||||
# Use ISO 8601 week numbering (%V) - weeks start on Monday
|
# Use ISO 8601 week and year numbering - weeks start on Monday
|
||||||
current_week <- as.numeric(format(report_date, "%V"))
|
# This matches the date-math approach in mosaic_creation.R
|
||||||
previous_week <- current_week - 1
|
|
||||||
|
|
||||||
# Handle year boundary
|
report_date <- as.Date(report_date)
|
||||||
if (previous_week < 1) {
|
|
||||||
previous_week <- 52
|
# Get ISO week and year for current date
|
||||||
}
|
current_week <- lubridate::isoweek(report_date)
|
||||||
|
current_iso_year <- lubridate::isoyear(report_date)
|
||||||
|
|
||||||
|
# Calculate previous week by subtracting 7 days and recalculating
|
||||||
|
previous_date <- report_date - 7
|
||||||
|
previous_week <- lubridate::isoweek(previous_date)
|
||||||
|
previous_iso_year <- lubridate::isoyear(previous_date)
|
||||||
|
|
||||||
return(list(
|
return(list(
|
||||||
current_week = current_week,
|
current_week = current_week,
|
||||||
|
current_iso_year = current_iso_year,
|
||||||
previous_week = previous_week,
|
previous_week = previous_week,
|
||||||
year = as.numeric(format(report_date, "%Y"))
|
previous_iso_year = previous_iso_year,
|
||||||
|
report_date = report_date
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue