diff --git a/r_app/80_calculate_kpis.R b/r_app/80_calculate_kpis.R index 10b7c86..3ad44c6 100644 --- a/r_app/80_calculate_kpis.R +++ b/r_app/80_calculate_kpis.R @@ -175,9 +175,6 @@ STATUS_TRIGGERS <- data.frame( stringsAsFactors = FALSE ) -# ============================================================================ -# MAIN -# ============================================================================ # ============================================================================ # MAIN @@ -260,16 +257,18 @@ main <- function() { message("PHASE 1: PER-FIELD WEEKLY ANALYSIS (SC-64 ENHANCEMENTS)") message(strrep("-", 70)) - current_week <- as.numeric(format(end_date, "%V")) - year <- as.numeric(format(end_date, "%Y")) - previous_week <- current_week - 1 - if (previous_week < 1) previous_week <- 52 - - message(paste("Week:", current_week, "/ Year:", year)) + # Calculate ISO week numbers and ISO years using helper from kpi_utils.R + weeks <- calculate_week_numbers(end_date) + current_week <- weeks$current_week + current_iso_year <- weeks$current_iso_year + previous_week <- weeks$previous_week + previous_iso_year <- weeks$previous_iso_year + + message(paste("Week:", current_week, "/ ISO Year:", current_iso_year)) # Find tile files - approach from Script 20 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 detected_grid_size <- NA @@ -285,7 +284,7 @@ main <- function() { tile_files <- list.files(mosaic_dir, pattern = tile_pattern, full.names = TRUE) 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")) @@ -361,7 +360,7 @@ main <- function() { # Build tile grid (needed by calculate_field_statistics) 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...") @@ -369,7 +368,7 @@ main <- function() { message("\n1. Loading/calculating CURRENT week statistics (week", current_week, ")...") current_stats <- load_or_calculate_weekly_stats( week_num = current_week, - year = year, + year = current_iso_year, project_dir = project_dir, field_boundaries_sf = field_boundaries_sf, mosaic_dir = tile_grid$mosaic_dir, @@ -387,7 +386,7 @@ main <- function() { prev_stats <- load_or_calculate_weekly_stats( week_num = previous_week, - year = year, + year = previous_iso_year, project_dir = project_dir, field_boundaries_sf = field_boundaries_sf, mosaic_dir = tile_grid$mosaic_dir, @@ -405,14 +404,14 @@ main <- function() { project_dir = project_dir, reports_dir = reports_dir, 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")) # Load weekly harvest probabilities from script 31 (if available) message("\n4. Loading harvest probabilities from script 31...") 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)) imminent_prob_data <- tryCatch({ @@ -438,7 +437,7 @@ main <- function() { message("\nCalculating gap filling scores (2σ method)...") # 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 @@ -473,7 +472,7 @@ main <- function() { 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, 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) if (length(tile_files) == 0) { @@ -739,7 +738,7 @@ main <- function() { NULL, project_dir, current_week, - year, + current_iso_year, reports_dir ) @@ -810,7 +809,7 @@ main <- function() { median_ci = round(median(field_data$Mean_CI, na.rm = TRUE), 2), mean_cv = round(mean(field_data$CI_CV, na.rm = TRUE), 4), week = current_week, - year = year, + year = current_iso_year, date = as.character(end_date) ) diff --git a/r_app/90_CI_report_with_kpis_simple.Rmd b/r_app/90_CI_report_with_kpis_simple.Rmd index 5a833db..dbe8c9c 100644 --- a/r_app/90_CI_report_with_kpis_simple.Rmd +++ b/r_app/90_CI_report_with_kpis_simple.Rmd @@ -119,8 +119,10 @@ kpi_data_dir <- file.path("..", "laravel_app", "storage", "app", project_dir, "r date_suffix <- format(as.Date(report_date), "%Y%m%d") # Calculate current week from report_date using ISO 8601 week numbering -current_week <- as.numeric(format(as.Date(report_date), "%V")) -week_suffix <- paste0("week", current_week) +report_date_obj <- as.Date(report_date) +current_week <- lubridate::isoweek(report_date_obj) +current_iso_year <- lubridate::isoyear(report_date_obj) +week_suffix <- paste0("week", sprintf("%02d", current_week), "_", current_iso_year) # Candidate filenames we expect (exact and common variants) expected_summary_names <- c( @@ -307,46 +309,39 @@ Sys.setlocale("LC_TIME", "C") today <- as.character(report_date) mail_day_as_character <- as.character(mail_day) -# Calculate report dates and weeks using ISO 8601 week numbering +# Calculate report dates and weeks using ISO 8601 week numbering (consistent with scripts 40 & 80) report_date_obj <- as.Date(today) -current_week <- as.numeric(format(report_date_obj, "%V")) -year <- as.numeric(format(report_date_obj, "%Y")) +current_week <- lubridate::isoweek(report_date_obj) +current_iso_year <- lubridate::isoyear(report_date_obj) +year <- lubridate::isoyear(report_date_obj) # Use ISO year, not calendar year -# Calculate dates for weekly analysis -week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7) +# Calculate dates for weekly analysis (Monday-based, consistent with ISO 8601) +week_start <- lubridate::floor_date(report_date_obj, unit = "week", week_start = 1) week_end <- week_start + 6 -# Calculate week days (copied from 05 script for compatibility) -report_date_as_week_day <- weekdays(lubridate::ymd(today)) -days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday") +# Calculate previous week dates using date arithmetic (handles year boundaries automatically) +today_minus_1 <- as.character(report_date_obj - 7) +today_minus_2 <- as.character(report_date_obj - 14) +today_minus_3 <- as.character(report_date_obj - 21) -# Calculate initial week number -week <- lubridate::week(today) -safe_log(paste("Initial week calculation:", week, "today:", today)) +# Calculate week numbers for previous weeks using date arithmetic +prev_week_1_date <- report_date_obj - 7 +prev_week_2_date <- report_date_obj - 14 +prev_week_3_date <- report_date_obj - 21 -# Calculate previous dates for comparisons -today_minus_1 <- as.character(lubridate::ymd(today) - 7) -today_minus_2 <- as.character(lubridate::ymd(today) - 14) -today_minus_3 <- as.character(lubridate::ymd(today) - 21) +week_minus_1 <- lubridate::isoweek(prev_week_1_date) +week_minus_1_year <- lubridate::isoyear(prev_week_1_date) -# Adjust week calculation based on mail day -if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) { - safe_log("Adjusting weeks because of mail day") - week <- lubridate::week(today) + 1 - today_minus_1 <- as.character(lubridate::ymd(today)) - today_minus_2 <- as.character(lubridate::ymd(today) - 7) - today_minus_3 <- as.character(lubridate::ymd(today) - 14) -} +week_minus_2 <- lubridate::isoweek(prev_week_2_date) +week_minus_2_year <- lubridate::isoyear(prev_week_2_date) -# Calculate week numbers for previous weeks -week_minus_1 <- week - 1 -week_minus_2 <- week - 2 -week_minus_3 <- week - 3 +week_minus_3 <- lubridate::isoweek(prev_week_3_date) +week_minus_3_year <- lubridate::isoyear(prev_week_3_date) # Format current week with leading zeros -week <- sprintf("%02d", week) +week <- sprintf("%02d", current_week) -safe_log(paste("Report week:", current_week, "Year:", year)) +safe_log(paste("Report week:", current_week, "ISO Year:", current_iso_year)) safe_log(paste("Week range:", week_start, "to", week_end)) ``` diff --git a/r_app/kpi_utils.R b/r_app/kpi_utils.R index 6bfebbc..816d07d 100644 --- a/r_app/kpi_utils.R +++ b/r_app/kpi_utils.R @@ -41,19 +41,26 @@ extract_ci_values <- function(ci_raster, field_vect) { #' @param report_date Date to calculate weeks for (default: today) #' @return List with current_week and previous_week numbers calculate_week_numbers <- function(report_date = Sys.Date()) { - # Use ISO 8601 week numbering (%V) - weeks start on Monday - current_week <- as.numeric(format(report_date, "%V")) - previous_week <- current_week - 1 + # Use ISO 8601 week and year numbering - weeks start on Monday + # This matches the date-math approach in mosaic_creation.R - # Handle year boundary - if (previous_week < 1) { - previous_week <- 52 - } + report_date <- as.Date(report_date) + + # 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( current_week = current_week, + current_iso_year = current_iso_year, previous_week = previous_week, - year = as.numeric(format(report_date, "%Y")) + previous_iso_year = previous_iso_year, + report_date = report_date )) }