diff --git a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd index bc00b39..3b6028d 100644 --- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd +++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd @@ -664,7 +664,9 @@ tryCatch({ # Helper function to safely load per-field mosaic if it exists load_per_field_mosaic <- function(base_dir, field_name, week, year) { path <- file.path(base_dir, field_name, paste0("week_", sprintf("%02d", week), "_", year, ".tif")) + cat(paste(" [DEBUG] Field:", field_name, "trying path:", path, "\n")) if (file.exists(path)) { + cat(paste(" ✓ File found\n")) tryCatch({ rast_obj <- terra::rast(path) # Extract CI band if present, otherwise first band @@ -677,6 +679,8 @@ tryCatch({ message(paste("Warning: Could not load", path, ":", e$message)) return(NULL) }) + } else { + cat(paste(" ✗ File NOT found\n")) } return(NULL) } diff --git a/r_app/DEBUG_remove_date_tiffs.R b/r_app/DEBUG_remove_date_tiffs.R index b500ab1..7dfa146 100644 --- a/r_app/DEBUG_remove_date_tiffs.R +++ b/r_app/DEBUG_remove_date_tiffs.R @@ -1,30 +1,39 @@ -# ============================================================================== -# DEBUG_REMOVE_DATE_TIFFS.R -# ============================================================================== -# PURPOSE: -# Remove all TIFFs of a specific date from multiple storage folders. -# Useful for debugging/re-running parts of the pipeline without full re-download. -# -# USAGE: -# Rscript DEBUG_remove_date_tiffs.R [project] [date] [--dry-run] [--skip-merged] [--skip-field-tiles] [--skip-field-tiles-ci] [--skip-daily-vals] -# -# EXAMPLES: -# # Remove 2026-02-08 from all folders (WITH CONFIRMATION) -# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 -# -# # Remove from all folders without confirmation -# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --no-confirm -# -# # Dry run - show what WOULD be deleted without deleting -# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --dry-run -# -# # Remove only from merged_tif and field_tiles, skip CI folders -# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-field-tiles-ci --skip-daily-vals -# -# # Remove from field_tiles_CI only -# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-merged --skip-field-tiles --skip-daily-vals -# -# ============================================================================== +#' DEBUG_REMOVE_DATE_TIFFS.R +#' ============================================================================== +#' PURPOSE: +#' Remove all TIFFs of a specific date OR date range from multiple storage folders. +#' Useful for debugging/re-running parts of the pipeline without full re-download. +#' +#' USAGE: +#' Rscript DEBUG_remove_date_tiffs.R [project] [date] [options] +#' Rscript DEBUG_remove_date_tiffs.R [project] --start-date [START] --end-date [END] [options] +#' +#' SINGLE DATE EXAMPLES: +#' # Remove 2026-02-08 from all folders (WITH CONFIRMATION) +#' Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 +#' +#' # Remove from all folders without confirmation +#' Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --no-confirm +#' +#' # Dry run - show what WOULD be deleted without deleting +#' Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --dry-run +#' +#' DATE RANGE EXAMPLES: +#' # Remove all dates from Nov 1, 2025 to Feb 11, 2026 +#' Rscript DEBUG_remove_date_tiffs.R aura --start-date 2025-11-01 --end-date 2026-02-11 --no-confirm +#' +#' # Dry run for date range +#' Rscript DEBUG_remove_date_tiffs.R aura --start-date 2025-11-01 --end-date 2026-02-11 --dry-run +#' +#' OPTIONS: +#' --dry-run Preview deletions without actually deleting +#' --no-confirm Delete without confirmation +#' --skip-merged Skip merged_tif folder +#' --skip-field-tiles Skip field_tiles folder +#' --skip-field-tiles-ci Skip field_tiles_CI folder +#' --skip-daily-vals Skip daily_vals folder +#' +#' ============================================================================== # ============================================================================== # CONFIGURATION - TOGGLE WHICH FOLDERS TO DELETE FROM (DEFAULT: ALL) @@ -51,11 +60,12 @@ main <- function() { # Validate minimum arguments if (length(args) < 2) { cat("\n[ERROR] Missing arguments\n") - cat("Usage: Rscript DEBUG_remove_date_tiffs.R [project] [date] [options]\n\n") + cat("Usage:\n") + cat(" Single date: Rscript DEBUG_remove_date_tiffs.R [project] [date] [options]\n") + cat(" Date range: Rscript DEBUG_remove_date_tiffs.R [project] --start-date [START] --end-date [END] [options]\n\n") cat("Examples:\n") cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08\n") - cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --dry-run\n") - cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-field-tiles-ci\n\n") + cat(" Rscript DEBUG_remove_date_tiffs.R aura --start-date 2025-11-01 --end-date 2026-02-11 --no-confirm\n\n") cat("Options:\n") cat(" --dry-run Preview deletions without actually deleting\n") cat(" --no-confirm Delete without confirmation\n") @@ -68,15 +78,51 @@ main <- function() { # Parse positional arguments project <- args[1] - date_str <- args[2] + + # Check if using date range or single date + date_str <- NULL + start_date_str <- NULL + end_date_str <- NULL + + # Look for --start-date and --end-date flags + start_idx <- which(args == "--start-date") + end_idx <- which(args == "--end-date") + + if (length(start_idx) > 0 && length(end_idx) > 0) { + # Date range mode + if (start_idx + 1 <= length(args)) { + start_date_str <- args[start_idx + 1] + } + if (end_idx + 1 <= length(args)) { + end_date_str <- args[end_idx + 1] + } + + if (is.null(start_date_str) || is.null(end_date_str)) { + cat("\n[ERROR] --start-date and --end-date require date values\n") + quit(status = 1) + } + } else { + # Single date mode + if (length(args) < 2 || startsWith(args[2], "--")) { + cat("\n[ERROR] Missing date argument. Either provide:\n") + cat(" - A single date: Rscript ... [project] 2026-02-08\n") + cat(" - Or --start-date and --end-date flags\n\n") + quit(status = 1) + } + date_str <- args[2] + } # Parse optional flags if (length(args) >= 3) { for (i in 3:length(args)) { arg <- args[i] - # Skip NA or empty arguments - if (is.na(arg) || nchar(arg) == 0) { + # Skip NA, empty, or flag values (already processed) + if (is.na(arg) || nchar(arg) == 0 || arg %in% c("--start-date", "--end-date")) { + next + } + if (i > 1 && args[i-1] %in% c("--start-date", "--end-date")) { + # Skip date values (already processed) next } @@ -96,157 +142,202 @@ main <- function() { } } - # Validate date format - date_obj <- tryCatch( - as.Date(date_str, format = "%Y-%m-%d"), - error = function(e) NULL - ) + # Validate and convert dates + dates_to_process <- c() - if (is.null(date_obj) || is.na(date_obj)) { - cat(sprintf("[ERROR] Invalid date format: %s (expected YYYY-MM-DD)\n", date_str)) - quit(status = 1) - } - # =========================================================================== - # BUILD LIST OF FOLDERS & FILES TO DELETE - # =========================================================================== - - base_path <- file.path("laravel_app", "storage", "app", project) - - files_to_delete <- list() - - # FOLDER 1: merged_tif/{DATE}.tif - if (DELETE_FROM_MERGED_TIF) { - merged_tif_file <- file.path(base_path, "merged_tif", paste0(date_str, ".tif")) - if (file.exists(merged_tif_file)) { - files_to_delete[["merged_tif"]] <- merged_tif_file + if (!is.null(date_str)) { + # Single date mode + date_obj <- tryCatch( + as.Date(date_str, format = "%Y-%m-%d"), + error = function(e) NULL + ) + + if (is.null(date_obj) || is.na(date_obj)) { + cat(sprintf("[ERROR] Invalid date format: %s (expected YYYY-MM-DD)\n", date_str)) + quit(status = 1) } - } - - # FOLDER 2: field_tiles/{FIELD}/{DATE}.tif (per-field structure) - if (DELETE_FROM_FIELD_TILES) { - field_tiles_dir <- file.path(base_path, "field_tiles") - if (dir.exists(field_tiles_dir)) { - field_dirs <- list.dirs(field_tiles_dir, full.names = TRUE, recursive = FALSE) - for (field_dir in field_dirs) { - tif_file <- file.path(field_dir, paste0(date_str, ".tif")) - if (file.exists(tif_file)) { - folder_name <- basename(field_dir) - key <- paste0("field_tiles/", folder_name) - files_to_delete[[key]] <- tif_file - } - } - } - } - - # FOLDER 3: field_tiles_CI/{FIELD}/{DATE}.tif (per-field structure) - if (DELETE_FROM_FIELD_TILES_CI) { - field_tiles_ci_dir <- file.path(base_path, "field_tiles_CI") - if (dir.exists(field_tiles_ci_dir)) { - field_dirs <- list.dirs(field_tiles_ci_dir, full.names = TRUE, recursive = FALSE) - for (field_dir in field_dirs) { - tif_file <- file.path(field_dir, paste0(date_str, ".tif")) - if (file.exists(tif_file)) { - folder_name <- basename(field_dir) - key <- paste0("field_tiles_CI/", folder_name) - files_to_delete[[key]] <- tif_file - } - } - } - } - - # FOLDER 4: Data/extracted_ci/daily_vals/{SUBDIR}/{DATE}.rds (per-subdirectory structure) - if (DELETE_FROM_DAILY_VALS) { - daily_vals_dir <- file.path(base_path, "Data", "extracted_ci", "daily_vals") - if (dir.exists(daily_vals_dir)) { - subdirs <- list.dirs(daily_vals_dir, full.names = TRUE, recursive = FALSE) - for (subdir in subdirs) { - rds_file <- file.path(subdir, paste0(date_str, ".rds")) - if (file.exists(rds_file)) { - subdir_name <- basename(subdir) - key <- paste0("daily_vals/", subdir_name) - files_to_delete[[key]] <- rds_file - } - } - } - } - - # =========================================================================== - # SUMMARY & CONFIRMATION - # =========================================================================== - - cat("\n") - cat(strrep("=", 70), "\n") - cat("DELETE DATE TIFFS - SUMMARY\n") - cat(strrep("=", 70), "\n") - cat(sprintf("Project: %s\n", project)) - cat(sprintf("Date: %s\n", date_str)) - cat(sprintf("Dry run: %s\n", if (DRY_RUN) "YES" else "NO")) - cat(sprintf("Files to delete: %d\n", length(files_to_delete))) - cat("\n") - - if (length(files_to_delete) == 0) { - cat("[INFO] No files found to delete\n") - cat(strrep("=", 70), "\n\n") - quit(status = 0) - } - - # Count files by folder type for compact summary - folder_counts <- table(sapply(names(files_to_delete), function(key) strsplit(key, "/")[[1]][1])) - cat("Files to delete by folder:\n") - for (folder in names(folder_counts)) { - cat(sprintf(" %s: %d file%s\n", folder, folder_counts[folder], if (folder_counts[folder] != 1) "s" else "")) - } - cat(sprintf(" Total: %d file%s\n", length(files_to_delete), if (length(files_to_delete) != 1) "s" else "")) - cat("\n") - - # Ask for confirmation (unless --no-confirm flag was used) - if (REQUIRE_CONFIRMATION && !DRY_RUN) { - # Check if running in interactive mode - if (!interactive()) { - cat("\n[ERROR] Non-interactive mode detected (running via Rscript)\n") - cat("Cannot prompt for confirmation. Use --no-confirm flag to proceed:\n") - cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --no-confirm\n\n") - cat(strrep("=", 70), "\n\n") + dates_to_process <- date_obj + } else { + # Date range mode + start_date_obj <- tryCatch( + as.Date(start_date_str, format = "%Y-%m-%d"), + error = function(e) NULL + ) + + end_date_obj <- tryCatch( + as.Date(end_date_str, format = "%Y-%m-%d"), + error = function(e) NULL + ) + + if (is.null(start_date_obj) || is.na(start_date_obj)) { + cat(sprintf("[ERROR] Invalid start date format: %s (expected YYYY-MM-DD)\n", start_date_str)) quit(status = 1) } - cat("⚠️ This will PERMANENTLY DELETE the above files!\n") + if (is.null(end_date_obj) || is.na(end_date_obj)) { + cat(sprintf("[ERROR] Invalid end date format: %s (expected YYYY-MM-DD)\n", end_date_str)) + quit(status = 1) + } + + if (start_date_obj > end_date_obj) { + cat(sprintf("[ERROR] Start date (%s) is after end date (%s)\n", start_date_str, end_date_str)) + quit(status = 1) + } + + # Generate sequence of dates + dates_to_process <- seq(start_date_obj, end_date_obj, by = "1 day") + } + + # =========================================================================== + # PROCESS DATES + # =========================================================================== + + total_dates <- length(dates_to_process) + total_files_deleted <- 0 + total_errors <- 0 + + cat("\n") + cat(strrep("=", 70), "\n") + cat("DELETE TIFFS - SUMMARY\n") + cat(strrep("=", 70), "\n") + cat(sprintf("Project: %s\n", project)) + + if (total_dates == 1) { + cat(sprintf("Date: %s\n", format(dates_to_process[1], "%Y-%m-%d"))) + } else { + cat(sprintf("Date range: %s to %s (%d dates)\n", + format(dates_to_process[1], "%Y-%m-%d"), + format(dates_to_process[total_dates], "%Y-%m-%d"), + total_dates)) + } + + cat(sprintf("Dry run: %s\n", if (DRY_RUN) "YES" else "NO")) + cat("\n") + + # Confirm before proceeding + if (REQUIRE_CONFIRMATION && !DRY_RUN) { + cat("⚠️ This will PERMANENTLY DELETE files from the above date(s)!\n") cat("Use --no-confirm flag to skip this prompt\n") - # Use readline() for interactive input (only works in interactive R/RStudio) - response <- readline(prompt = "Type 'yes' to confirm, or anything else to cancel: ") - - if (tolower(response) != "yes") { - cat("[CANCELLED] No files deleted\n") + # Check if running in interactive mode + if (interactive()) { + response <- readline(prompt = "Type 'yes' to confirm, or anything else to cancel: ") + + if (tolower(response) != "yes") { + cat("[CANCELLED] No files deleted\n") + cat(strrep("=", 70), "\n\n") + quit(status = 0) + } + } else { + cat("\n[ERROR] Non-interactive mode detected (running via Rscript)\n") + cat("Cannot prompt for confirmation. Use --no-confirm flag to proceed\n\n") cat(strrep("=", 70), "\n\n") - quit(status = 0) + quit(status = 1) } } # =========================================================================== - # DELETE OR DRY-RUN + # LOOP THROUGH DATES AND DELETE # =========================================================================== - deleted_count <- 0 - error_count <- 0 + cat("Processing...\n\n") - for (i in seq_along(files_to_delete)) { - folder_key <- names(files_to_delete)[i] - file_path <- files_to_delete[[i]] + for (date_idx in seq_along(dates_to_process)) { + current_date <- dates_to_process[date_idx] + date_str <- format(current_date, "%Y-%m-%d") - if (!DRY_RUN) { - # file.remove() returns logical; check the return value - success <- tryCatch({ - file.remove(file_path) - }, error = function(e) { - # If unexpected exception, treat as failure - FALSE - }) + base_path <- file.path("laravel_app", "storage", "app", project) + files_to_delete <- list() + + # FOLDER 1: merged_tif/{DATE}.tif + if (DELETE_FROM_MERGED_TIF) { + merged_tif_file <- file.path(base_path, "merged_tif", paste0(date_str, ".tif")) + if (file.exists(merged_tif_file)) { + files_to_delete[["merged_tif"]] <- merged_tif_file + } + } + + # FOLDER 2: field_tiles/{FIELD}/{DATE}.tif (per-field structure) + if (DELETE_FROM_FIELD_TILES) { + field_tiles_dir <- file.path(base_path, "field_tiles") + if (dir.exists(field_tiles_dir)) { + field_dirs <- list.dirs(field_tiles_dir, full.names = TRUE, recursive = FALSE) + for (field_dir in field_dirs) { + tif_file <- file.path(field_dir, paste0(date_str, ".tif")) + if (file.exists(tif_file)) { + folder_name <- basename(field_dir) + key <- paste0("field_tiles/", folder_name) + files_to_delete[[key]] <- tif_file + } + } + } + } + + # FOLDER 3: field_tiles_CI/{FIELD}/{DATE}.tif (per-field structure) + if (DELETE_FROM_FIELD_TILES_CI) { + field_tiles_ci_dir <- file.path(base_path, "field_tiles_CI") + if (dir.exists(field_tiles_ci_dir)) { + field_dirs <- list.dirs(field_tiles_ci_dir, full.names = TRUE, recursive = FALSE) + for (field_dir in field_dirs) { + tif_file <- file.path(field_dir, paste0(date_str, ".tif")) + if (file.exists(tif_file)) { + folder_name <- basename(field_dir) + key <- paste0("field_tiles_CI/", folder_name) + files_to_delete[[key]] <- tif_file + } + } + } + } + + # FOLDER 4: Data/extracted_ci/daily_vals/{SUBDIR}/{DATE}.rds (per-subdirectory structure) + if (DELETE_FROM_DAILY_VALS) { + daily_vals_dir <- file.path(base_path, "Data", "extracted_ci", "daily_vals") + if (dir.exists(daily_vals_dir)) { + subdirs <- list.dirs(daily_vals_dir, full.names = TRUE, recursive = FALSE) + for (subdir in subdirs) { + rds_file <- file.path(subdir, paste0(date_str, ".rds")) + if (file.exists(rds_file)) { + subdir_name <- basename(subdir) + key <- paste0("daily_vals/", subdir_name) + files_to_delete[[key]] <- rds_file + } + } + } + } + + # Delete files for this date + deleted_count <- 0 + error_count <- 0 + + for (i in seq_along(files_to_delete)) { + file_path <- files_to_delete[[i]] - if (isTRUE(success)) { - deleted_count <- deleted_count + 1 + if (!DRY_RUN) { + success <- tryCatch({ + file.remove(file_path) + }, error = function(e) { + FALSE + }) + + if (isTRUE(success)) { + deleted_count <- deleted_count + 1 + } else { + error_count <- error_count + 1 + } } else { - error_count <- error_count + 1 + deleted_count <- length(files_to_delete) + } + } + + total_files_deleted <- total_files_deleted + deleted_count + total_errors <- total_errors + error_count + + # Progress indicator (every 5 dates or on last date) + if (total_dates == 1 || date_idx %% 5 == 0 || date_idx == total_dates) { + if (DRY_RUN) { + cat(sprintf("[%d/%d] %s: Would delete %d files\n", date_idx, total_dates, date_str, deleted_count)) + } else { + cat(sprintf("[%d/%d] %s: Deleted %d files\n", date_idx, total_dates, date_str, deleted_count)) } } } @@ -256,14 +347,20 @@ main <- function() { # =========================================================================== cat("\n") + cat(strrep("=", 70), "\n") + cat("SUMMARY\n") + cat(strrep("=", 70), "\n") + cat(sprintf("Dates processed: %d\n", total_dates)) + if (DRY_RUN) { - cat(sprintf("[DRY RUN] Would have deleted %d files\n", length(files_to_delete))) + cat(sprintf("Files that would be deleted: %d\n", total_files_deleted)) } else { - cat(sprintf("Deleted: %d files\n", deleted_count)) - if (error_count > 0) { - cat(sprintf("Errors: %d files\n", error_count)) + cat(sprintf("Total files deleted: %d\n", total_files_deleted)) + if (total_errors > 0) { + cat(sprintf("Errors: %d\n", total_errors)) } } + cat(strrep("=", 70), "\n\n") quit(status = 0) diff --git a/r_app/MANUAL_PIPELINE_RUNNER.R b/r_app/MANUAL_PIPELINE_RUNNER.R index 9414d37..fa8f69a 100644 --- a/r_app/MANUAL_PIPELINE_RUNNER.R +++ b/r_app/MANUAL_PIPELINE_RUNNER.R @@ -438,9 +438,9 @@ # rmarkdown::render( rmarkdown::render( "r_app/90_CI_report_with_kpis_agronomic_support.Rmd", - params = list(data_dir = "john", report_date = as.Date("2026-02-04")), - output_file = "SmartCane_Report_agronomic_support_john_2026-02-04.docx", - output_dir = "laravel_app/storage/app/john/reports" + params = list(data_dir = "aura", report_date = as.Date("2026-01-01")), + output_file = "SmartCane_Report_agronomic_support_aura_2026-01-01.docx", + output_dir = "laravel_app/storage/app/aura/reports" ) # # COMMAND #2 - CANE SUPPLY REPORT (ANGATA, CHEMBA, XINAVANE, ESA): diff --git a/r_app/report_utils.R b/r_app/report_utils.R index 0d6ffe3..da18901 100644 --- a/r_app/report_utils.R +++ b/r_app/report_utils.R @@ -73,8 +73,12 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = reverse = TRUE )) # Add layout elements - map <- map + tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), - main.title.size = 0.7) + map <- map + tm_title(text = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), + size = 0.7) + # Add layout configuration to prevent legend rescaling + map <- map + tm_layout(legend.position = c("left", "bottom"), + legend.outside = FALSE, + inner.margins = 0.05) # Add borders if requested if (borders) { @@ -137,8 +141,12 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege reverse = TRUE )) # Add layout elements - map <- map + tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"), - main.title.size = 0.7) + map <- map + tm_title(text = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"), + size = 0.7) + # Add layout configuration to prevent legend rescaling + map <- map + tm_layout(legend.position = c("right", "bottom"), + legend.outside = FALSE, + inner.margins = 0.05) # Add borders if requested if (borders) { @@ -195,25 +203,23 @@ ci_plot <- function(pivotName, if (missing(current_ci) || is.null(current_ci)) { stop("current_ci is required") } - if (missing(ci_minus_1) || is.null(ci_minus_1)) { - stop("ci_minus_1 is required") - } - if (missing(ci_minus_2) || is.null(ci_minus_2)) { - stop("ci_minus_2 is required") - } - if (missing(last_week_diff) || is.null(last_week_diff)) { - stop("last_week_diff is required") - } - if (missing(three_week_diff) || is.null(three_week_diff)) { - stop("three_week_diff is required") - } + # Note: ci_minus_1, ci_minus_2, last_week_diff, three_week_diff are now optional + # (may be NULL if historical data is not available for early seasons) if (missing(harvesting_data) || is.null(harvesting_data)) { stop("harvesting_data is required") } + # Warn if critical rasters are missing + if (is.null(ci_minus_1) || is.null(ci_minus_2)) { + safe_log(paste("Warning: Historical CI data missing for field", pivotName, "- will show current week only"), "WARNING") + } + if (is.null(last_week_diff) || is.null(three_week_diff)) { + safe_log(paste("Warning: Difference rasters missing for field", pivotName, "- difference maps skipped"), "WARNING") + } + # Extract pivot shape and age data tryCatch({ - pivotShape <- field_boundaries %>% terra::subset(field %in% pivotName) %>% sf::st_transform(terra::crs(current_ci)) + pivotShape <- field_boundaries %>% dplyr::filter(field %in% pivotName) %>% sf::st_transform(terra::crs(current_ci)) age <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% sort("year") %>% @@ -247,33 +253,69 @@ ci_plot <- function(pivotName, sf::st_transform(sf::st_crs(pivotShape)) %>% dplyr::filter(field %in% pivotName) - # Create the maps for different timepoints - CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, - show_legend = TRUE, legend_is_portrait = TRUE, - week = week_minus_2, age = age - 2, borders = borders, colorblind = colorblind_friendly) - - CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, - show_legend = FALSE, legend_is_portrait = FALSE, - week = week_minus_1, age = age - 1, borders = borders, colorblind = colorblind_friendly) - + # Create maps conditionally based on data availability + # Always create current week map (required) CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2, show_legend = FALSE, legend_is_portrait = FALSE, week = week, age = age, borders = borders, colorblind = colorblind_friendly) - # Create difference maps - only show legend on the second one to avoid redundancy - CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week, AllPivots2, joined_spans2, - show_legend = FALSE, legend_is_portrait = FALSE, - week_1 = week, week_2 = week_minus_1, age = age, borders = borders, colorblind = colorblind_friendly) - CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2, - show_legend = TRUE, legend_is_portrait = TRUE, - week_1 = week, week_2 = week_minus_3, age = age, borders = borders, colorblind = colorblind_friendly) - # Arrange the maps with equal widths - tst <- tmap_arrange(CImap_m2, CImap_m1, CImap, CI_max_abs_last_week, CI_max_abs_three_week, - nrow = 1, widths = c(0.23, 0.18, 0.18, 0.18, 0.23)) + # Create historical maps only if data is available + maps_to_arrange <- list(CImap) + widths_to_use <- c(1) + field_heading_note <- "" + + # Try to create 2-week ago map + if (!is.null(singlePivot_m2)) { + CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, + show_legend = TRUE, legend_is_portrait = TRUE, + week = week_minus_2, age = age - 2, borders = borders, colorblind = colorblind_friendly) + maps_to_arrange <- c(list(CImap_m2), maps_to_arrange) + widths_to_use <- c(0.4, widths_to_use) + } + + # Try to create 1-week ago map + if (!is.null(singlePivot_m1)) { + CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, + show_legend = FALSE, legend_is_portrait = FALSE, + week = week_minus_1, age = age - 1, borders = borders, colorblind = colorblind_friendly) + maps_to_arrange <- c(maps_to_arrange, list(CImap_m1)) + widths_to_use <- c(widths_to_use, 0.3) + } + + # Try to create 1-week difference map + if (!is.null(abs_CI_last_week)) { + CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week, AllPivots2, joined_spans2, + show_legend = FALSE, legend_is_portrait = FALSE, + week_1 = week, week_2 = week_minus_1, age = age, borders = borders, colorblind = colorblind_friendly) + maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_last_week)) + widths_to_use <- c(widths_to_use, 0.3) + } + + # Try to create 3-week difference map + if (!is.null(abs_CI_three_week)) { + CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2, + show_legend = TRUE, legend_is_portrait = TRUE, + week_1 = week, week_2 = week_minus_3, age = age, borders = borders, colorblind = colorblind_friendly) + maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_three_week)) + widths_to_use <- c(widths_to_use, 0.4) + } + + # Normalize widths to sum to 1 + widths_to_use <- widths_to_use / sum(widths_to_use) + + # Add note if historical data is limited + if (length(maps_to_arrange) == 1) { + field_heading_note <- " (Current week only - historical data not yet available)" + } else if (length(maps_to_arrange) < 5) { + field_heading_note <- " (Limited historical data)" + } + + # Arrange the maps with normalized widths + tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths_to_use))) # Output heading and map to R Markdown age_months <- round(age / 4.348, 1) - cat(paste("## Field", pivotName, "-", age, "weeks/", age_months, "months after planting/harvest", "\n\n")) + cat(paste("## Field", pivotName, "-", age, "weeks/", age_months, "months after planting/harvest", field_heading_note, "\n\n")) print(tst) }, error = function(e) {