Merge pull request #6 from TimonWeitkamp/SC-119

Sc 119

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"))
+  # 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
   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)
       )
       

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"))
+report_date_obj <- as.Date(report_date)
-week_suffix <- paste0("week", current_week)
+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"))
+current_week <- lubridate::isoweek(report_date_obj)
-year <- as.numeric(format(report_date_obj, "%Y"))
+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
+# Calculate dates for weekly analysis (Monday-based, consistent with ISO 8601)
-week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7)
+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)
+# Calculate previous week dates using date arithmetic (handles year boundaries automatically)
-report_date_as_week_day <- weekdays(lubridate::ymd(today))
+today_minus_1 <- as.character(report_date_obj - 7)
-days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
+today_minus_2 <- as.character(report_date_obj - 14)
+today_minus_3 <- as.character(report_date_obj - 21)
 
-# Calculate initial week number
+# Calculate week numbers for previous weeks using date arithmetic
-week <- lubridate::week(today)
+prev_week_1_date <- report_date_obj - 7
-safe_log(paste("Initial week calculation:", week, "today:", today))
+prev_week_2_date <- report_date_obj - 14
+prev_week_3_date <- report_date_obj - 21
 
-# Calculate previous dates for comparisons
+week_minus_1 <- lubridate::isoweek(prev_week_1_date)
-today_minus_1 <- as.character(lubridate::ymd(today) - 7)
+week_minus_1_year <- lubridate::isoyear(prev_week_1_date)
-today_minus_2 <- as.character(lubridate::ymd(today) - 14)
-today_minus_3 <- as.character(lubridate::ymd(today) - 21)
 
-# Adjust week calculation based on mail day
+week_minus_2 <- lubridate::isoweek(prev_week_2_date)
-if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
+week_minus_2_year <- lubridate::isoyear(prev_week_2_date)
-  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)
-}
 
-# Calculate week numbers for previous weeks
+week_minus_3 <- lubridate::isoweek(prev_week_3_date)
-week_minus_1 <- week - 1
+week_minus_3_year <- lubridate::isoyear(prev_week_3_date)
-week_minus_2 <- week - 2
-week_minus_3 <- week - 3
 
 # 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))
 ```
 

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
+  # 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(
     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
   ))
 }