diff --git a/.claude/settings.local.json b/.claude/settings.local.json new file mode 100644 index 0000000..e5ab04a --- /dev/null +++ b/.claude/settings.local.json @@ -0,0 +1,12 @@ +{ + "permissions": { + "allow": [ + "Bash(python -c \":*)", + "Bash(where python)", + "Bash(where py)", + "Bash(where python3)", + "Bash(where conda)", + "Bash(/c/Users/timon/AppData/Local/r-miniconda/python.exe -c \":*)" + ] + } +} diff --git a/r_app/30_growth_model_utils.R b/r_app/30_growth_model_utils.R index cca107e..189d968 100644 --- a/r_app/30_growth_model_utils.R +++ b/r_app/30_growth_model_utils.R @@ -71,54 +71,43 @@ load_combined_ci_data <- function(daily_vals_dir, harvesting_data = NULL) { safe_log(sprintf("Filtered to %d files within harvest season date range", length(all_daily_files))) } - # Set up parallel future plan (Windows PSOCK multisession; Mac/Linux can use forking) - # Automatically detect available cores and limit to reasonable number - n_cores <- min(parallel::detectCores() - 1, 8) # Use max 8 cores (diminishing returns after) - future::plan(strategy = future::multisession, workers = n_cores) - safe_log(sprintf("Using %d parallel workers for file I/O", n_cores)) - - # Parallel file reading: future_map_dfr processes each file in parallel - # Returns combined dataframe directly (no need to rbind) - combined_long <- furrr::future_map_dfr( - all_daily_files, - .progress = TRUE, - .options = furrr::furrr_options(seed = TRUE), - function(file) { - # Extract date from filename: {YYYY-MM-DD}.rds - filename <- basename(file) - date_str <- tools::file_path_sans_ext(filename) - - # Parse date - if (nchar(date_str) == 10 && grepl("^\\d{4}-\\d{2}-\\d{2}$", date_str)) { - parsed_date <- as.Date(date_str, format = "%Y-%m-%d") - } else { - return(data.frame()) # Return empty dataframe if parse fails - } - - if (is.na(parsed_date)) { - return(data.frame()) - } - - # Read RDS file - tryCatch({ - rds_data <- readRDS(file) - - if (is.null(rds_data) || nrow(rds_data) == 0) { - return(data.frame()) - } - - # Add date column to the data - rds_data %>% - dplyr::mutate(Date = parsed_date) - - }, error = function(e) { - return(data.frame()) # Return empty dataframe on error - }) - } - ) - - # Return to sequential processing to avoid nested parallelism - future::plan(future::sequential) + # Adaptive core count: scale with file count to avoid parallel overhead on small projects + n_files <- length(all_daily_files) + n_cores_io <- if (n_files < 200) { + 1 + } else if (n_files < 600) { + 2 + } else if (n_files < 1500) { + min(parallel::detectCores() - 1, 4) + } else { + min(parallel::detectCores() - 1, 8) + } + safe_log(sprintf("Using %d parallel workers for file I/O (%d files)", n_cores_io, n_files)) + + read_one_file <- function(file) { + filename <- basename(file) + date_str <- tools::file_path_sans_ext(filename) + if (nchar(date_str) != 10 || !grepl("^\\d{4}-\\d{2}-\\d{2}$", date_str)) return(data.frame()) + parsed_date <- as.Date(date_str, format = "%Y-%m-%d") + if (is.na(parsed_date)) return(data.frame()) + tryCatch({ + rds_data <- readRDS(file) + if (is.null(rds_data) || nrow(rds_data) == 0) return(data.frame()) + rds_data %>% dplyr::mutate(Date = parsed_date) + }, error = function(e) data.frame()) + } + + if (n_cores_io > 1) { + future::plan(strategy = future::multisession, workers = n_cores_io) + combined_long <- furrr::future_map_dfr( + all_daily_files, read_one_file, + .progress = TRUE, + .options = furrr::furrr_options(seed = TRUE) + ) + future::plan(future::sequential) + } else { + combined_long <- purrr::map_dfr(all_daily_files, read_one_file) + } if (nrow(combined_long) == 0) { safe_log("Warning: No valid CI data loaded from daily files", "WARNING") @@ -244,57 +233,81 @@ generate_interpolated_ci_data <- function(years, harvesting_data, ci_data) { failed_fields <- list() total_fields <- 0 successful_fields <- 0 - + + # Pre-compute total valid fields across all years to decide core count once + total_valid_fields <- sum(sapply(years, function(yr) { + sfs <- harvesting_data %>% + dplyr::filter(year == yr, !is.na(season_start)) %>% + dplyr::pull(sub_field) + sum(sfs %in% unique(ci_data$sub_field)) + })) + + # Adaptive core count: scale with field count, avoid parallel overhead for small projects + n_cores_interp <- if (total_valid_fields <= 1) { + 1 + } else if (total_valid_fields <= 10) { + 2 + } else if (total_valid_fields <= 50) { + min(parallel::detectCores() - 1, 4) + } else { + min(parallel::detectCores() - 1, 8) + } + + safe_log(sprintf("Interpolating %d fields across %d year(s) using %d worker(s)", + total_valid_fields, length(years), n_cores_interp)) + + # Set up parallel plan once before the year loop (avoid per-year startup cost) + if (n_cores_interp > 1) { + future::plan(strategy = future::multisession, workers = n_cores_interp) + } + # Process each year result <- purrr::map_df(years, function(yr) { # Get the fields harvested in this year with valid season start dates sub_fields <- harvesting_data %>% dplyr::filter(year == yr, !is.na(season_start)) %>% dplyr::pull(sub_field) - - if (length(sub_fields) == 0) { - return(data.frame()) - } - + + if (length(sub_fields) == 0) return(data.frame()) + # Filter sub_fields to only include those with value data in ci_data valid_sub_fields <- sub_fields %>% purrr::keep(~ any(ci_data$sub_field == .x)) - - if (length(valid_sub_fields) == 0) { - return(data.frame()) - } - + + if (length(valid_sub_fields) == 0) return(data.frame()) + total_fields <<- total_fields + length(valid_sub_fields) - safe_log(sprintf("Year %d: Processing %d fields in parallel", yr, length(valid_sub_fields))) - - # Set up parallel future plan for field interpolation - # Allocate 1 core per ~100 fields (with minimum 2 cores) - n_cores <- max(2, min(parallel::detectCores() - 1, ceiling(length(valid_sub_fields) / 100))) - future::plan(strategy = future::multisession, workers = n_cores) - - # PARALLELIZE: Process all fields in parallel (each extracts & interpolates independently) - result_list <- furrr::future_map( - valid_sub_fields, - .progress = TRUE, - .options = furrr::furrr_options(seed = TRUE), - function(field) { - # Call with verbose=FALSE to suppress warnings during parallel iteration - extract_CI_data(field, - harvesting_data = harvesting_data, - field_CI_data = ci_data, + safe_log(sprintf("Year %d: Processing %d fields", yr, length(valid_sub_fields))) + + # Process fields — parallel if workers > 1, otherwise plain map (no overhead) + if (n_cores_interp > 1) { + result_list <- furrr::future_map( + valid_sub_fields, + .progress = TRUE, + .options = furrr::furrr_options(seed = TRUE), + function(field) { + extract_CI_data(field, + harvesting_data = harvesting_data, + field_CI_data = ci_data, + season = yr, + verbose = FALSE) + } + ) + } else { + result_list <- purrr::map(valid_sub_fields, function(field) { + extract_CI_data(field, + harvesting_data = harvesting_data, + field_CI_data = ci_data, season = yr, - verbose = FALSE) - } - ) - - # Return to sequential processing - future::plan(future::sequential) - + verbose = TRUE) + }) + } + # Process results and tracking for (i in seq_along(result_list)) { field_result <- result_list[[i]] field_name <- valid_sub_fields[i] - + if (nrow(field_result) > 0) { successful_fields <<- successful_fields + 1 } else { @@ -305,15 +318,16 @@ generate_interpolated_ci_data <- function(years, harvesting_data, ci_data) { ) } } - + # Combine all results for this year - result_list <- result_list[sapply(result_list, nrow) > 0] # Keep only non-empty - if (length(result_list) > 0) { - purrr::list_rbind(result_list) - } else { - data.frame() - } + result_list <- result_list[sapply(result_list, nrow) > 0] + if (length(result_list) > 0) purrr::list_rbind(result_list) else data.frame() }) + + # Tear down parallel plan once after all years are processed + if (n_cores_interp > 1) { + future::plan(future::sequential) + } # Print summary safe_log(sprintf("\n=== Interpolation Summary ===")) 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 0fc4b53..4b3775d 100644 --- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd +++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd @@ -12,8 +12,8 @@ params: facet_by_season: FALSE x_axis_unit: "days" output: - word_document: - reference_docx: !expr file.path("word-styles-reference-var1.docx") + word_document: + reference_docx: !expr file.path("word-styles-reference-var1.docx") toc: no editor_options: chunk_output_type: console @@ -472,9 +472,8 @@ tryCatch({ translations <- do.call(rbind, translation_list) if (!is.null(translations)) { - safe_log("Translations file succesfully loaded") - } else { - safe_log("Failed to load translations", "ERROR") + safe_log("Translations file successfully loaded") + } else { safe_log("Failed to load translations", "ERROR") translations <- NULL } }, error = function(e) { @@ -498,72 +497,7 @@ tryCatch({ localisation <<- NULL }) -# Helper function to handle missing translation keys -tr_key <- function(key) { - if (key %in% names(tr)) { - txt <- glue(tr[key], .envir = parent.frame()) - txt <- gsub("\n", " \n", txt) - return(enc2utf8(as.character(txt))) - } else if (is.na(key)) { - return(tr_key("NA")) - } else if (key == "") { - return("") - } else { - return(paste0(key)) - } -} - -# ============================================================================ -# SHARED TREND MAPPING HELPER -# ============================================================================ -# Canonical function for converting trend text to arrows/formatted text -# Normalizes all legacy and current trend category names to standardized output -# Used by: combined_kpi_table, field_details_table, and compact_field_display chunks -map_trend_to_arrow <- function(text_vec, include_text = FALSE) { - # Normalize: convert to character and lowercase - text_lower <- tolower(as.character(text_vec)) - - # Apply mapping to each element - sapply(text_lower, function(text) { - # Handle NA and empty values - if (is.na(text) || text == "" || nchar(trimws(text)) == 0) { - return(NA_character_) - } - - # Determine category and build output with translated labels - # Using word-boundary anchored patterns (perl=TRUE) to avoid substring mis-matches - if (grepl("\\bstrong growth\\b", text, perl = TRUE)) { - arrow <- "↑↑" - trans_key <- "Strong growth" - } else if (grepl("\\b(?:slight|weak) growth\\b|(? @@ -781,144 +715,12 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table `r tr_key("field_alerts")` ```{r field_alerts_table, echo=FALSE, results='asis'} -# Generate alerts for all fields -generate_field_alerts <- function(field_details_table) { - if (is.null(field_details_table) || nrow(field_details_table) == 0) { - return(NULL) # Return NULL to signal no data - } - - # Check for required columns - required_cols <- c("Field", "Growth Uniformity", "Yield Forecast (t/ha)", - "Gap Score", "Decline Risk", "Patchiness Risk", "Mean CI", "CV Value", "Moran's I") - missing_cols <- setdiff(required_cols, colnames(field_details_table)) - - if (length(missing_cols) > 0) { - message("Field details missing required columns: ", paste(missing_cols, collapse = ", ")) - return(NULL) # Return NULL if required columns are missing - } - - alerts_list <- list() - - # Get unique fields - unique_fields <- unique(field_details_table$Field) - - for (field_name in unique_fields) { - field_data <- field_details_table %>% filter(Field == field_name) - - # Aggregate data for the field - field_summary <- field_data %>% - summarise( - uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"), - avg_yield_forecast = mean(`Yield Forecast (t/ha)`, na.rm = TRUE), - max_gap_score = max(`Gap Score`, na.rm = TRUE), - highest_decline_risk = case_when( - any(`Decline Risk` == "Very-high") ~ "Very-high", - any(`Decline Risk` == "High") ~ "High", - any(`Decline Risk` == "Moderate") ~ "Moderate", - any(`Decline Risk` == "Low") ~ "Low", - TRUE ~ "Unknown" - ), - highest_patchiness_risk = case_when( - any(`Patchiness Risk` == "High") ~ "High", - any(`Patchiness Risk` == "Medium") ~ "Medium", - any(`Patchiness Risk` == "Low") ~ "Low", - any(`Patchiness Risk` == "Minimal") ~ "Minimal", - TRUE ~ "Unknown" - ), - avg_mean_ci = mean(`Mean CI`, na.rm = TRUE), - avg_cv = mean(`CV Value`, na.rm = TRUE), - .groups = 'drop' - ) - - # Generate alerts for this field based on simplified CV-Moran's I priority system (3 levels) - field_alerts <- c() - - # Get CV and Moran's I values - avg_cv <- field_summary$avg_cv - morans_i <- mean(field_data[["Moran's I"]], na.rm = TRUE) - - # Determine priority level (1=Urgent, 2=Monitor, 3=No stress) - priority_level <- get_field_priority_level(avg_cv, morans_i) - - # Generate alerts based on priority level - if (priority_level == 1) { - field_alerts <- c(field_alerts, tr_key("priority")) - } else if (priority_level == 2) { - field_alerts <- c(field_alerts, tr_key("monitor")) - } - # Priority 3: No alert (no stress) - - # Keep other alerts for decline risk, patchiness risk, gap score - if (field_summary$highest_decline_risk %in% c("High", "Very-high")) { - field_alerts <- c(field_alerts, tr_key("growth_decline")) - } - if (field_summary$highest_patchiness_risk == "High") { - field_alerts <- c(field_alerts, tr_key("high_patchiness")) - } - if (field_summary$max_gap_score > 20) { - field_alerts <- c(field_alerts, tr_key("gaps_present")) - } - - # Only add alerts if there are any (skip fields with no alerts) - if (length(field_alerts) > 0) { - # Add to alerts list - for (alert in field_alerts) { - alerts_list[[length(alerts_list) + 1]] <- data.frame( - Field = field_name, - Alert = alert - ) - } - } - } - - # Combine all alerts - if (length(alerts_list) > 0) { - alerts_df <- do.call(rbind, alerts_list) - return(alerts_df) - } else { - return(data.frame(Field = character(), Alert = character())) - } -} +# generate_field_alerts() is defined in 90_report_utils.R (sourced above). +# field_details_table has already been normalised by normalize_field_details_columns(). # Generate and display alerts table if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) { - # Adapter: Map normalized column names back to legacy names for generate_field_alerts() - # (generates from the normalized schema created by normalize_field_details_columns + column_mappings) - field_details_for_alerts <- field_details_table - - # Rename normalized columns back to legacy names (only if they exist) - if ("Field_id" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(Field = Field_id) - } - if ("Mean_CI" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Mean CI` = Mean_CI) - } - if ("CV" %in% names(field_details_for_alerts) && !("CV Value" %in% names(field_details_for_alerts))) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`CV Value` = CV) - } - if ("TCH_Forecasted" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Yield Forecast (t/ha)` = TCH_Forecasted) - } - if ("Gap_Score" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Gap Score` = Gap_Score) - } - if ("Uniformity_Category" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Growth Uniformity` = Uniformity_Category) - } - if ("Decline_Risk" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Decline Risk` = Decline_Risk) - } - if ("Decline_Severity" %in% names(field_details_for_alerts) && !("Decline Risk" %in% names(field_details_for_alerts))) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Decline Risk` = Decline_Severity) - } - if ("Patchiness_Risk" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Patchiness Risk` = Patchiness_Risk) - } - if ("Morans_I" %in% names(field_details_for_alerts)) { - field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Moran's I` = Morans_I) - } - - alerts_data <- generate_field_alerts(field_details_for_alerts) + alerts_data <- generate_field_alerts(field_details_table) if (!is.null(alerts_data) && nrow(alerts_data) > 0) { ft <- flextable(alerts_data) %>% # set_caption("Field Alerts Summary") %>% @@ -1027,36 +829,23 @@ if (!exists("field_details_table") || is.null(field_details_table)) { tryCatch({ safe_log("Starting farm-level raster aggregation for overview maps") - # Helper function to safely aggregate mosaics for a specific week - aggregate_mosaics_safe <- function(week_num, year_num, label) { - tryCatch({ - safe_log(paste("Aggregating mosaics for", label, "(week", week_num, ",", year_num, ")")) - - # Call the utility function from 90_report_utils.R - # This function reads all per-field mosaics and merges them into a single raster - farm_mosaic <- aggregate_per_field_mosaics_to_farm_level( - weekly_mosaic_dir = weekly_CI_mosaic, - target_week = week_num, - target_year = year_num - ) - - if (!is.null(farm_mosaic)) { - safe_log(paste("✓ Successfully aggregated farm mosaic for", label, "")) - return(farm_mosaic) - } else { - safe_log(paste("Warning: Farm mosaic is NULL for", label), "WARNING") - return(NULL) - } - }, error = function(e) { - safe_log(paste("Error aggregating mosaics for", label, ":", e$message), "WARNING") - return(NULL) - }) - } - - # Aggregate mosaics for three weeks: current, week-1, week-3 - farm_mosaic_current <- aggregate_mosaics_safe(current_week, current_iso_year, "current week") - farm_mosaic_minus_1 <- aggregate_mosaics_safe(as.numeric(week_minus_1), week_minus_1_year, "week-1") - farm_mosaic_minus_3 <- aggregate_mosaics_safe(as.numeric(week_minus_3), week_minus_3_year, "week-3") + # Aggregate per-field mosaics into farm-level rasters for current, week-1, week-3 + # aggregate_per_field_mosaics_to_farm_level() is defined in 90_report_utils.R (sourced above) + farm_mosaic_current <- aggregate_per_field_mosaics_to_farm_level( + weekly_mosaic_dir = weekly_CI_mosaic, + target_week = current_week, + target_year = current_iso_year + ) + farm_mosaic_minus_1 <- aggregate_per_field_mosaics_to_farm_level( + weekly_mosaic_dir = weekly_CI_mosaic, + target_week = as.numeric(week_minus_1), + target_year = week_minus_1_year + ) + farm_mosaic_minus_3 <- aggregate_per_field_mosaics_to_farm_level( + weekly_mosaic_dir = weekly_CI_mosaic, + target_week = as.numeric(week_minus_3), + target_year = week_minus_3_year + ) # Extract CI band (5th band, or named "CI") from each aggregated mosaic farm_ci_current <- NULL @@ -1111,18 +900,7 @@ tryCatch({ AllPivots0_ll <- AllPivots0 target_crs <- "EPSG:4326" - downsample_raster <- function(r, max_cells = 2000000) { - if (is.null(r)) { - return(NULL) - } - n_cells <- terra::ncell(r) - if (!is.na(n_cells) && n_cells > max_cells) { - fact <- ceiling(sqrt(n_cells / max_cells)) - safe_log(paste("Downsampling raster by factor", fact), "INFO") - return(terra::aggregate(r, fact = fact, fun = mean, na.rm = TRUE)) - } - r - } + # downsample_raster() is defined in 90_report_utils.R (sourced above) if (!is.null(farm_ci_current) && !terra::is.lonlat(farm_ci_current)) { farm_ci_current_ll <- terra::project(farm_ci_current, target_crs, method = "bilinear") @@ -1396,14 +1174,8 @@ tryCatch({ dplyr::group_by(field) %>% dplyr::summarise(.groups = 'drop') - # Helper to get week/year from a date - get_week_year <- function(date) { - list( - week = as.numeric(format(date, "%V")), - year = as.numeric(format(date, "%G")) - ) - } - + # get_week_year() is defined in 90_report_utils.R (sourced above) + # Calculate week/year for current and historical weeks current_ww <- get_week_year(as.Date(today)) minus_1_ww <- get_week_year(as.Date(today) - lubridate::weeks(1)) @@ -1413,26 +1185,8 @@ tryCatch({ message(paste("Processing", nrow(AllPivots_merged), "fields for weeks:", current_ww$week, minus_1_ww$week, minus_2_ww$week, minus_3_ww$week)) - # 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")) - if (file.exists(path)) { - tryCatch({ - rast_obj <- terra::rast(path) - # Extract CI band if present, otherwise first band - if ("CI" %in% names(rast_obj)) { - return(rast_obj[["CI"]]) - } else if (nlyr(rast_obj) > 0) { - return(rast_obj[[1]]) - } - }, error = function(e) { - message(paste("Warning: Could not load", path, ":", e$message)) - return(NULL) - }) - } - return(NULL) - } - + # load_per_field_mosaic() is defined in 90_report_utils.R (sourced above) + # Iterate through fields using purrr::walk purrr::walk(AllPivots_merged$field, function(field_name) { tryCatch({ @@ -1571,38 +1325,7 @@ tryCatch({ }) ``` -```{r generate_subarea_visualizations, eval=FALSE, echo=FALSE, fig.height=3.8, fig.width=6.5, message=FALSE, warning=FALSE, dpi=150, results='asis'} -# Alternative visualization grouped by sub-area (disabled by default) -tryCatch({ - # Group pivots by sub-area - pivots_grouped <- AllPivots0 - - # Iterate over each subgroup - for (subgroup in unique(pivots_grouped$sub_area)) { - # Add subgroup heading - cat("\n") - cat("## Subgroup: ", subgroup, "\n") - - # Filter data for current subgroup - subset_data <- dplyr::filter(pivots_grouped, sub_area == subgroup) - - # Generate visualizations for each field in the subgroup - purrr::walk(subset_data$field, function(field_name) { - cat("\n") - ci_plot(field_name) - cat("\n") - cum_ci_plot(field_name) - cat("\n") - }) - - # Add page break after each subgroup - cat("\\newpage\n") - } -}, error = function(e) { - safe_log(paste("Error in subarea visualization section:", e$message), "ERROR") - cat("Error generating subarea plots. See log for details.\n") -}) -``` +\newpage `r tr_key("detailed_field")` @@ -1700,7 +1423,7 @@ if (!exists("field_details_table") || is.null(field_details_table) || nrow(field field_details_clean <- field_details_clean %>% select( field = Field_id, - field_size = field_size_acres, + field_size = field_size_area, mean_ci = Mean_CI, yield_forecast = TCH_Forecasted, gap_score = Gap_Score, diff --git a/r_app/90_report_utils.R b/r_app/90_report_utils.R index faead47..b713290 100644 --- a/r_app/90_report_utils.R +++ b/r_app/90_report_utils.R @@ -24,8 +24,35 @@ subchunkify <- function(g, fig_height=7, fig_width=5) { "\n`","`` ") - cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE)) -} + cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE)) +} + +#' Translate a key using the global `tr` vector, with an optional fallback. +#' Unified replacement for the Rmd's tr_key() — covers both markdown text and +#' plot/map labels. Supports {variable} placeholders resolved from the caller. +#' Falls back to `fallback` (if provided) or the key string itself when missing. +tr_key <- function(key, fallback = NULL) { + tr_exists <- exists("tr", envir = globalenv(), inherits = FALSE) + + if (tr_exists && !is.na(key) && key %in% names(get("tr", envir = globalenv()))) { + raw <- get("tr", envir = globalenv())[[key]] + } else if (!is.null(fallback)) { + raw <- as.character(fallback) + } else if (is.na(key)) { + return(tr_key("NA")) + } else if (identical(key, "")) { + return("") + } else { + return(enc2utf8(as.character(key))) + } + + result <- tryCatch( + as.character(glue::glue(raw, .envir = parent.frame())), + error = function(e) as.character(raw) + ) + # Convert literal \n (as stored in Excel cells) to real newlines + enc2utf8(gsub("\\n", "\n", result, fixed = TRUE)) +} #' Creates a Chlorophyll Index map for a pivot #' @@ -74,7 +101,7 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = outliers.trunc = c(TRUE, TRUE) ), col.legend = tm_legend( - title = "CI", + title = tr_key("map_legend_ci_title", "CI"), orientation = if (legend_is_portrait) "portrait" else "landscape", show = show_legend, position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"), @@ -82,8 +109,9 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = ) ) # Add layout elements + age_days <- age * 7 map <- map + tm_layout( - main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), + main.title = tr_key("map_title_max_ci", "Max CI week {week}\n{age} weeks ({age_days} days) old"), main.title.size = 0.7, #legend.height = 0.85, # Constrain vertical legend height to not exceed map asp = 1 # Fixed aspect ratio @@ -151,7 +179,7 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege outliers.trunc = c(TRUE, TRUE) ), col.legend = tm_legend( - title = "CI diff.", + title = tr_key("map_legend_ci_diff", "CI diff."), orientation = if (legend_is_portrait) "portrait" else "landscape", show = show_legend, position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"), @@ -159,8 +187,9 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege ) ) # Add layout elements + age_days <- age * 7 map <- map + tm_layout( - main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"), + main.title = tr_key("map_title_ci_change", "CI change week {week_1} - week {week_2}\n{age} weeks ({age_days} days) old"), main.title.size = 0.7, #legend.height = 0.85, # Constrain vertical legend height to not exceed map asp = 1 # Fixed aspect ratio @@ -344,7 +373,7 @@ ci_plot <- function(pivotName, # 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", field_heading_note, "\n\n")) + cat(paste0("## ", tr_key("field_section_header", "Field {pivotName} - {age} weeks/ {age_months} months after planting/harvest"), field_heading_note, "\n\n")) print(tst) }, error = function(e) { @@ -400,7 +429,11 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " mean_rolling_10_days = zoo::rollapplyr(value, width = 10, FUN = mean, partial = TRUE)) data_ci2 <- data_ci2 %>% dplyr::mutate(season = as.factor(season)) - + + # Resolved translated labels (used for y-axis labels and facet strip labels) + rolling_mean_label <- tr_key("lbl_rolling_mean_ci", "10-Day Rolling Mean CI") + cumulative_label <- tr_key("lbl_cumulative_ci", "Cumulative CI") + # Compute benchmarks if requested and not provided if (show_benchmarks && is.null(benchmark_data)) { benchmark_data <- compute_ci_benchmarks(ci_quadrant_data, estate_name, benchmark_percentiles) @@ -411,8 +444,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " benchmark_data <- benchmark_data %>% dplyr::mutate( ci_type_label = case_when( - ci_type == "value" ~ "10-Day Rolling Mean CI", - ci_type == "cumulative_CI" ~ "Cumulative CI", + ci_type == "value" ~ rolling_mean_label, + ci_type == "cumulative_CI" ~ cumulative_label, TRUE ~ ci_type ), benchmark_label = paste0(percentile, "th Percentile") @@ -454,9 +487,9 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } x_label <- switch(x_unit, - "days" = if (facet_on) "Date" else "Age of Crop (Days)", - "weeks" = "Week Number") - + "days" = if (facet_on) tr_key("lbl_date", "Date") else tr_key("lbl_age_of_crop_days", "Age of Crop (Days)"), + "weeks" = tr_key("lbl_week_number", "Week Number")) + # Calculate dynamic max values for breaks max_dah <- max(plot_data$DAH, na.rm = TRUE) + 20 max_week <- max(as.numeric(plot_data$week), na.rm = TRUE) + ceiling(20 / 7) @@ -473,12 +506,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " group = .data[["sub_field"]] ) ) + - ggplot2::labs(title = paste("Plot of", y_label), - color = "Field Name", + ggplot2::labs(title = paste(tr_key("lbl_plot_of", "Plot of"), y_label), + color = tr_key("lbl_field_name", "Field Name"), y = y_label, x = x_label) + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y", - sec.axis = ggplot2::sec_axis(~ ., name = "Age in Months", + sec.axis = ggplot2::sec_axis(~ ., name = tr_key("lbl_age_in_months", "Age in Months"), breaks = scales::breaks_pretty(), labels = function(x) round(as.numeric(x - min(x)) / 30.44, 1))) + ggplot2::theme_minimal() + @@ -547,16 +580,16 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " ), linewidth = 1.5, alpha = 1 ) + - ggplot2::labs(title = paste("Plot of", y_label, "for Field", pivotName, title_suffix), - color = "Season", + ggplot2::labs(title = paste(tr_key("lbl_plot_of", "Plot of"), y_label, tr_key("lbl_for_field", "for Field"), pivotName, title_suffix), + color = tr_key("lbl_season", "Season"), y = y_label, x = x_label) + color_scale + { if (x_var == "DAH") { - ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1))) + ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = tr_key("lbl_age_in_months", "Age in Months"), breaks = seq(0, 14, by = 1))) } else if (x_var == "week") { - ggplot2::scale_x_continuous(breaks = seq(0, max_week, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = "Age in Months", breaks = seq(0, 14, by = 1))) + ggplot2::scale_x_continuous(breaks = seq(0, max_week, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = tr_key("lbl_age_in_months", "Age in Months"), breaks = seq(0, 14, by = 1))) } } + ggplot2::theme_minimal() + @@ -581,19 +614,19 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " # Generate plots based on plot_type if (plot_type == "absolute") { - g <- create_plot("mean_rolling_10_days", "10-Day Rolling Mean CI", "") + g <- create_plot("mean_rolling_10_days", rolling_mean_label, "") subchunkify(g, 2.8, 10) } else if (plot_type == "cumulative") { - g <- create_plot("cumulative_CI", "Cumulative CI", "") + g <- create_plot("cumulative_CI", cumulative_label, "") subchunkify(g, 2.8, 10) } else if (plot_type == "both") { # Create faceted plot with both CI types using pivot_longer approach - plot_data_both <- data_ci3 %>% + plot_data_both <- data_ci3 %>% dplyr::filter(season %in% unique_seasons) %>% dplyr::mutate( ci_type_label = case_when( - ci_type == "mean_rolling_10_days" ~ "10-Day Rolling Mean CI", - ci_type == "cumulative_CI" ~ "Cumulative CI", + ci_type == "mean_rolling_10_days" ~ rolling_mean_label, + ci_type == "cumulative_CI" ~ cumulative_label, TRUE ~ ci_type ), is_latest = season == latest_season # Flag for latest season @@ -607,9 +640,9 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } x_label <- switch(x_unit, - "days" = if (facet_on) "Date" else "Age of Crop (Days)", - "weeks" = "Week Number") - + "days" = if (facet_on) tr_key("lbl_date", "Date") else tr_key("lbl_age_of_crop_days", "Age of Crop (Days)"), + "weeks" = tr_key("lbl_week_number", "Week Number")) + # Choose color palette based on colorblind_friendly flag color_scale <- if (colorblind_friendly) { ggplot2::scale_color_brewer(type = "qual", palette = "Set2") @@ -620,7 +653,10 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " # Calculate dynamic max values for breaks max_dah_both <- max(plot_data_both$DAH, na.rm = TRUE) + 20 max_week_both <- max(as.numeric(plot_data_both$week), na.rm = TRUE) + ceiling(20 / 7) - + + # Pre-evaluate translated title here (not inside labs()) so {pivotName} resolves correctly + both_plot_title <- tr_key("lbl_ci_analysis_title", "CI Analysis for Field {pivotName}") + # Create the faceted plot g_both <- ggplot2::ggplot(data = plot_data_both) + # Add benchmark lines first (behind season lines) @@ -636,8 +672,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " DAH }, ci_type_label = case_when( - ci_type == "value" ~ "10-Day Rolling Mean CI", - ci_type == "cumulative_CI" ~ "Cumulative CI", + ci_type == "value" ~ rolling_mean_label, + ci_type == "cumulative_CI" ~ cumulative_label, TRUE ~ ci_type ) ) @@ -675,18 +711,18 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " ), linewidth = 1.5, alpha = 1 ) + - ggplot2::labs(title = paste("CI Analysis for Field", pivotName), - color = "Season", - y = "CI Value", + ggplot2::labs(title = both_plot_title, + color = tr_key("lbl_season", "Season"), + y = tr_key("lbl_ci_value", "CI Value"), x = x_label) + color_scale + { if (x_var == "DAH") { - ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1))) + ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = tr_key("lbl_age_in_months", "Age in Months"), breaks = seq(0, 14, by = 1))) } else if (x_var == "week") { - ggplot2::scale_x_continuous(breaks = seq(0, max_week_both, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = "Age in Months", breaks = seq(0, 14, by = 1))) + ggplot2::scale_x_continuous(breaks = seq(0, max_week_both, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = tr_key("lbl_age_in_months", "Age in Months"), breaks = seq(0, 14, by = 1))) } else if (x_var == "Date") { - ggplot2::scale_x_date(breaks = "1 month", date_labels = "%b-%Y", sec.axis = ggplot2::sec_axis(~ ., name = "Age in Months", breaks = scales::breaks_pretty())) + ggplot2::scale_x_date(breaks = "1 month", date_labels = "%b-%Y", sec.axis = ggplot2::sec_axis(~ ., name = tr_key("lbl_age_in_months", "Age in Months"), breaks = scales::breaks_pretty())) } } + ggplot2::theme_minimal() + @@ -707,7 +743,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " # Add invisible points to set the y-axis range for rolling mean facet dummy_data <- data.frame( - ci_type_label = "10-Day Rolling Mean CI", + ci_type_label = rolling_mean_label, ci_value = c(0, 7), stringsAsFactors = FALSE ) @@ -749,11 +785,14 @@ cum_ci_plot2 <- function(pivotName){ date_seq <- seq.Date(from = start_date, to = end_date, by = "month") midpoint_date <- start_date + (end_date - start_date) / 2 + # Pre-evaluate translated title here (not inside labs()) so {pivotName} resolves correctly + fallback_title <- tr_key("lbl_rolling_mean_fallback", "14 day rolling MEAN CI rate - Field {pivotName}") + g <- ggplot() + scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") + scale_y_continuous(limits = c(0, 4)) + - labs(title = paste("14 day rolling MEAN CI rate - Field ", pivotName), - x = "Date", y = "CI Rate") + + labs(title = fallback_title, + x = tr_key("lbl_date", "Date"), y = tr_key("lbl_ci_rate", "CI Rate")) + theme_minimal() + theme(axis.text.x = element_text(hjust = 0.5), legend.justification = c(1, 0), @@ -761,7 +800,7 @@ cum_ci_plot2 <- function(pivotName){ legend.position.inside = c(1, 0), legend.title = element_text(size = 8), legend.text = element_text(size = 8)) + - annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5) + annotate("text", x = midpoint_date, y = 2, label = tr_key("lbl_no_data", "No data available"), size = 6, hjust = 0.5) subchunkify(g, 3.2, 10) @@ -1175,31 +1214,295 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr #' Normalize field_details_table column structure #' -#' Standardizes column names and ensures all expected KPI columns exist. -#' Handles Field → Field_id rename and injects missing columns as NA. +#' Standardizes column names from various legacy and pipeline-generated schemas +#' into a single canonical set, then ensures all expected KPI columns exist +#' (adding \code{NA} columns for any that are absent). #' -#' @param field_details_table data.frame to normalize -#' @return data.frame with standardized column structure +#' Rename rules applied in order: +#' \itemize{ +#' \item \code{Field} → \code{Field_id} +#' \item \code{Mean CI} → \code{Mean_CI} +#' \item \code{CV Value} → \code{CV} +#' \item \code{TCH_Forecasted} / \code{Yield Forecast (t/ha)} → \code{TCH_Forecasted} +#' \item \code{Gap Score} → \code{Gap_Score} +#' \item \code{Growth Uniformity} / \code{Uniformity_Category} → \code{Uniformity_Interpretation} +#' \item \code{Decline_Risk} → \code{Decline_Severity} +#' \item \code{Moran's I} / \code{Morans_I} → \code{Morans_I} +#' } +#' +#' @param field_details_table A data.frame to normalize. +#' @return A data.frame with standardized column names and all expected KPI +#' columns present (missing ones filled with \code{NA}). normalize_field_details_columns <- function(field_details_table) { if (is.null(field_details_table) || nrow(field_details_table) == 0) { return(field_details_table) } - - # Rename Field → Field_id if needed - if ("Field" %in% names(field_details_table) && !("Field_id" %in% names(field_details_table))) { - field_details_table <- field_details_table %>% - dplyr::rename(Field_id = Field) + + rename_if_missing <- function(df, from, to) { + if (from %in% names(df) && !to %in% names(df)) + df <- dplyr::rename(df, !!to := !!rlang::sym(from)) + df } - + + field_details_table <- field_details_table %>% + rename_if_missing("Field", "Field_id") %>% + rename_if_missing("Mean CI", "Mean_CI") %>% + rename_if_missing("CV Value", "CV") %>% + rename_if_missing("Yield Forecast (t/ha)", "TCH_Forecasted") %>% + rename_if_missing("Gap Score", "Gap_Score") %>% + rename_if_missing("Growth Uniformity", "Uniformity_Interpretation") %>% + rename_if_missing("Uniformity_Category", "Uniformity_Interpretation") %>% + rename_if_missing("Decline_Risk", "Decline_Severity") %>% + rename_if_missing("Moran's I", "Morans_I") + # Ensure all expected KPI columns exist; add as NA if missing - expected_cols <- c("Field_id", "Mean_CI", "CV", "TCH_Forecasted", "Gap_Score", - "Trend_Interpretation", "Weekly_CI_Change", "Uniformity_Interpretation", - "Decline_Severity", "Patchiness_Risk") + expected_cols <- c( + "Field_id", "Mean_CI", "CV", "Morans_I", "TCH_Forecasted", "Gap_Score", + "Trend_Interpretation", "Weekly_CI_Change", "Uniformity_Interpretation", + "Decline_Severity", "Patchiness_Risk" + ) for (col in expected_cols) { if (!col %in% names(field_details_table)) { field_details_table[[col]] <- NA } } - + return(field_details_table) } + +# ============================================================================== +# TREND / ARROW HELPERS +# ============================================================================== + +#' Map trend text to arrow symbols or formatted labels +#' +#' Converts trend category strings (e.g. \code{"strong growth"}, +#' \code{"slight decline"}) to Unicode arrow symbols, optionally combined with +#' translated text labels. Normalises legacy and current trend category names +#' to a canonical output. Vectorised over \code{text_vec}. +#' +#' @param text_vec Character vector of trend category strings. +#' @param include_text Logical. If \code{TRUE}, returns +#' \code{"Label (arrow)"}; if \code{FALSE} (default), returns the arrow +#' symbol only. +#' @return Character vector the same length as \code{text_vec}. \code{NA} is +#' returned for missing / empty inputs; an em-dash (\code{"—"}) is returned +#' for unrecognised values when \code{include_text = FALSE}. +#' @seealso \code{\link{tr_key}} +#' +map_trend_to_arrow <- function(text_vec, include_text = FALSE) { + text_lower <- tolower(as.character(text_vec)) + + sapply(text_lower, function(text) { + if (is.na(text) || nchar(trimws(text)) == 0) return(NA_character_) + + if (grepl("\\bstrong growth\\b", text, perl = TRUE)) { + arrow <- "↑↑"; trans_key <- "Strong growth" + } else if (grepl("\\b(?:slight|weak) growth\\b|(? max_cells) { + fact <- ceiling(sqrt(n_cells / max_cells)) + safe_log(paste("Downsampling raster by factor", fact), "INFO") + return(terra::aggregate(r, fact = fact, fun = fun, na.rm = TRUE)) + } + r +} + +#' Load the CI band from a per-field weekly mosaic +#' +#' Locates the weekly mosaic TIF for the given field and week via +#' \code{\link{get_per_field_mosaic_path}}, loads it with +#' \code{terra::rast()}, and returns the CI band (the layer named \code{"CI"}, +#' or the first layer as a fallback). +#' +#' @param base_dir Path to the \code{weekly_mosaic} directory. +#' @param field_name Name of the field sub-directory. +#' @param week ISO week number. +#' @param year ISO year. +#' @return A single-layer \code{SpatRaster} (CI band), or \code{NULL} if the +#' file does not exist or cannot be loaded. +#' @seealso \code{\link{get_per_field_mosaic_path}} +#' +load_per_field_mosaic <- function(base_dir, field_name, week, year) { + path <- get_per_field_mosaic_path(base_dir, field_name, week, year) + if (is.null(path)) return(NULL) + + tryCatch({ + rast_obj <- terra::rast(path) + if ("CI" %in% names(rast_obj)) { + return(rast_obj[["CI"]]) + } else if (terra::nlyr(rast_obj) > 0) { + return(rast_obj[[1]]) + } + NULL + }, error = function(e) { + safe_log(paste("Could not load mosaic:", path, "-", e$message), "WARNING") + NULL + }) +} + +# ============================================================================== +# FIELD ALERT GENERATION +# ============================================================================== + +#' Generate field-level alert flags from normalised KPI data +#' +#' Evaluates each field's CV, Moran's I, decline severity, patchiness risk, +#' and gap score against threshold rules, returning a tidy data frame of +#' translated alert messages. Only fields that trigger at least one alert are +#' included in the output. +#' +#' Expects a table that has been passed through +#' \code{\link{normalize_field_details_columns}}, which guarantees the columns +#' \code{Field_id}, \code{CV}, \code{Morans_I}, \code{Decline_Severity}, +#' \code{Patchiness_Risk}, and \code{Gap_Score} are present. +#' +#' Alert rules: +#' \itemize{ +#' \item Priority 1 (Urgent) or 2 (Monitor) from +#' \code{\link{get_field_priority_level}} based on CV / Moran's I. +#' \item Decline risk High or Very-high. +#' \item Patchiness risk High. +#' \item Gap score \eqn{> 20}. +#' } +#' +#' @param field_details_table A data frame normalised by +#' \code{\link{normalize_field_details_columns}}. +#' @return A data frame with columns \code{Field} and \code{Alert}, one row +#' per alert per field. Returns an empty 0-row data frame when no alerts +#' are triggered, or \code{NULL} if the input is empty / missing required +#' columns. +#' @seealso \code{\link{get_field_priority_level}}, \code{\link{normalize_field_details_columns}} +#' +generate_field_alerts <- function(field_details_table) { + if (is.null(field_details_table) || nrow(field_details_table) == 0) { + return(NULL) + } + + required_cols <- c("Field_id", "CV", "Morans_I", "Decline_Severity", + "Patchiness_Risk", "Gap_Score") + missing_cols <- setdiff(required_cols, names(field_details_table)) + if (length(missing_cols) > 0) { + safe_log(paste("generate_field_alerts: missing columns:", + paste(missing_cols, collapse = ", ")), "WARNING") + return(NULL) + } + + summaries <- field_details_table %>% + dplyr::group_by(Field_id) %>% + dplyr::summarise( + avg_cv = mean(CV, na.rm = TRUE), + avg_morans_i = mean(Morans_I, na.rm = TRUE), + max_gap = suppressWarnings(max(Gap_Score, na.rm = TRUE)), + highest_decline = dplyr::case_when( + any(Decline_Severity == "Very-high", na.rm = TRUE) ~ "Very-high", + any(Decline_Severity == "High", na.rm = TRUE) ~ "High", + any(Decline_Severity == "Moderate", na.rm = TRUE) ~ "Moderate", + any(Decline_Severity == "Low", na.rm = TRUE) ~ "Low", + TRUE ~ "Unknown" + ), + highest_patchiness = dplyr::case_when( + any(Patchiness_Risk == "High", na.rm = TRUE) ~ "High", + any(Patchiness_Risk == "Medium", na.rm = TRUE) ~ "Medium", + any(Patchiness_Risk == "Low", na.rm = TRUE) ~ "Low", + any(Patchiness_Risk == "Minimal", na.rm = TRUE) ~ "Minimal", + TRUE ~ "Unknown" + ), + .groups = "drop" + ) %>% + dplyr::mutate( + priority = purrr::map2_int(avg_cv, avg_morans_i, get_field_priority_level), + max_gap = dplyr::if_else(is.infinite(max_gap), NA_real_, max_gap) + ) + + alerts <- summaries %>% + dplyr::mutate( + a_priority = dplyr::case_when( + priority == 1 ~ tr_key("priority"), + priority == 2 ~ tr_key("monitor"), + TRUE ~ NA_character_ + ), + a_decline = dplyr::if_else( + highest_decline %in% c("High", "Very-high"), tr_key("growth_decline"), NA_character_ + ), + a_patch = dplyr::if_else( + highest_patchiness == "High", tr_key("high_patchiness"), NA_character_ + ), + a_gap = dplyr::if_else( + !is.na(max_gap) & max_gap > 20, tr_key("gaps_present"), NA_character_ + ) + ) %>% + tidyr::pivot_longer( + cols = c(a_priority, a_decline, a_patch, a_gap), + names_to = NULL, + values_to = "Alert" + ) %>% + dplyr::filter(!is.na(Alert)) %>% + dplyr::select(Field = Field_id, Alert) + + if (nrow(alerts) == 0) { + return(data.frame(Field = character(), Alert = character())) + } + + alerts +} diff --git a/r_app/MANUAL_PIPELINE_RUNNER.R b/r_app/MANUAL_PIPELINE_RUNNER.R index 9575bfd..bea508a 100644 --- a/r_app/MANUAL_PIPELINE_RUNNER.R +++ b/r_app/MANUAL_PIPELINE_RUNNER.R @@ -439,14 +439,14 @@ rmarkdown::render( "r_app/90_CI_report_with_kpis_agronomic_support.Rmd", params = list(data_dir = "aura", report_date = as.Date("2026-02-18"), language = "en" ), - output_file = "SmartCane_Report_agronomic_support_aura_2026-02-18_en.docx", + output_file = "SmartCane_Report_agronomic_support_aura_2026-02-18_en_test.docx", output_dir = "laravel_app/storage/app/aura/reports" ) rmarkdown::render( "r_app/90_CI_report_with_kpis_agronomic_support.Rmd", params = list(data_dir = "aura", report_date = as.Date("2026-02-18"), language = "es" ), - output_file = "SmartCane_Report_agronomic_support_aura_2026-02-18_es.docx", + output_file = "SmartCane_Report_agronomic_support_aura_2026-02-18_es_test.docx", output_dir = "laravel_app/storage/app/aura/reports" ) # @@ -461,179 +461,3 @@ rmarkdown::render( output_dir = "laravel_app/storage/app/angata/reports" ) # -# EXPECTED OUTPUT: -# File: SmartCane_Report_*_{PROJECT}_{DATE}.docx -# Location: laravel_app/storage/app/{PROJECT}/reports/ -# Script execution time: 5-10 minutes -# -# NOTE: -# These are R Markdown files and cannot be run directly via Rscript -# Use rmarkdown::render() from an R interactive session or wrapper script -# See run_full_pipeline.R for an automated example -# -# ============================================================================ - - -# ============================================================================== -# QUICK REFERENCE: Common Workflows -# ============================================================================== -# -# WORKFLOW A: Weekly Update (Most Common) -# ───────────────────────────────────────────────────────────────────────── -# Goal: Process latest week of data through full pipeline -# -# Parameters: -# $PROJECT = "angata" -# $END_DATE = "2026-02-04" # Today or latest date available -# $OFFSET = 7 # One week back -# -# Steps: -# 1. SKIP Python download (if you already have data) -# 2. Run R10: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/10_create_per_field_tiffs.R angata 2026-02-04 7 -# (Argument order: [PROJECT] [END_DATE] [OFFSET]) -# 3. Run R20: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/20_ci_extraction_per_field.R angata 2026-02-04 7 -# 4. Run R30: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/30_interpolate_growth_model.R angata -# 5. Run R21: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/21_convert_ci_rds_to_csv.R angata -# 6. Run R40: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/40_mosaic_creation_per_field.R 2026-02-04 7 angata -# (Argument order: [END_DATE] [OFFSET] [PROJECT]) -# 7. Run R80: & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/80_calculate_kpis.R 2026-02-04 angata 7 -# (Argument order: [END_DATE] [PROJECT] [OFFSET] - DIFFERENT from R40!) -# 8. OPTIONAL R91 (Cane Supply) - Use automated runner: -# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/run_full_pipeline.R -# OR from R console: -# rmarkdown::render("r_app/91_CI_report_with_kpis_cane_supply.Rmd", -# params=list(data_dir="angata", report_date=as.Date("2026-02-04")), -# output_file="SmartCane_Report_cane_supply_angata_2026-02-04.docx", -# output_dir="laravel_app/storage/app/angata/reports") -# -# Execution time: ~60-90 minutes total -# -# -# WORKFLOW B: Initial Setup (Large Backfill) -# ───────────────────────────────────────────────────────────────────────── -# Goal: Process multiple weeks of historical data -# -# Steps: -# 1. Python download (your entire date range) -# 2. Run R10 with large offset to process all historical dates: -# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/10_create_per_field_tiffs.R angata 2026-02-04 365 -# (This processes from 2025-02-04 to 2026-02-04, covering entire year) -# 3. Run R20 with large offset to process all historical dates: -# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/20_ci_extraction_per_field.R angata 2026-02-04 365 -# (This processes from 2025-02-04 to 2026-02-04, covering entire year) -# 4. Run R30 once (growth model full season) -# 5. Run R21 once (CSV export) -# 6. Run R40 with specific week windows as needed -# 7. Run R80 for each week you want KPIs for - -# 6. For each week, run: -# - R40 with different END_DATE values (one per week) -# - R80 with different WEEK/YEAR values (one per week) -# - R91 optional (one per week report) -# -# Pro tip: Script R40 with offset=14 covers two weeks at once -# Then R40 again with offset=7 for just one week -# -# -# WORKFLOW C: Troubleshooting (Check Intermediate Outputs) -# ───────────────────────────────────────────────────────────────────────── -# Goal: Verify outputs before moving to next step -# -# After R10: Check field_tiles/{FIELD_ID}/ has #dates files -# After R20: Check field_tiles_CI/{FIELD_ID}/ has same #dates files -# After R30: Check Data/extracted_ci/cumulative_vals/ has All_pivots_*.rds -# After R40: Check weekly_mosaic/{FIELD_ID}/ has week_WW_YYYY.tif per week -# After R80: Check output/ has {PROJECT}_field_analysis_week*.xlsx -# -# ============================================================================ - -# ============================================================================== -# TROUBLESHOOTING -# ============================================================================== -# -# ISSUE: R20 not processing all field_tiles files -# ──────────────────────────────────────────────── -# Symptom: field_tiles has 496 files, field_tiles_CI only has 5 -# -# Possible causes: -# 1. Source files incomplete or corrupted -# 2. Script 20 skips because CI TIFF already exists (even if incomplete) -# 3. Partial run from previous attempt -# -# Solutions: -# 1. Delete the small number of files in field_tiles_CI/{FIELD}/ (don't delete all!) -# rm laravel_app/storage/app/angata/field_tiles_CI/{fieldnum}/* -# 2. Re-run Script 20 -# 3. If still fails, delete field_tiles_CI completely and re-run Script 20 -# rm -r laravel_app/storage/app/angata/field_tiles_CI/ -# -# ISSUE: Script 80 says "No per-field mosaic files found" -# ──────────────────────────────────────────────────────── -# Symptom: R80 fails to calculate KPIs -# -# Possible causes: -# 1. Script 40 hasn't run yet (weekly_mosaic doesn't exist) -# 2. Wrong END_DATE or WEEK/YEAR combination -# 3. weekly_mosaic/{FIELD}/ directory missing (old format?) -# -# Solutions: -# 1. Ensure Script 40 has completed: Check weekly_mosaic/{FIELD}/ exists with week_WW_YYYY.tif -# 2. Verify END_DATE is within date range of available CI data -# 3. For current week: End date must be THIS week (same ISO week as today) -# -# ISSUE: Python download fails ("Not authorized") -# ──────────────────────────────────────────────── -# Symptom: python 00_download_8band_pu_optimized.py fails with authentication error -# -# Cause: PLANET_API_KEY environment variable not set -# -# Solution: -# 1. Save your Planet API key: $env:PLANET_API_KEY = "your_key_here" -# 2. Verify: $env:PLANET_API_KEY (should show your key) -# 3. Try download again -# -# ISSUE: R30 takes too long -# ────────────────────────── -# Symptom: Script 30 running for >30 minutes -# -# Cause: LOESS interpolation is slow with many dates/fields -# -# Solution: -# 1. This is normal - large date ranges slow down interpolation -# 2. Subsequent runs are faster (cached results) -# 3. If needed: reduce offset or run fewer weeks at a time -# -# ============================================================================== - -# ============================================================================== -# SUMMARY OF FILES CREATED BY EACH SCRIPT -# ============================================================================== -# -# Script 10 creates: -# laravel_app/storage/app/{PROJECT}/field_tiles/{FIELD}/{DATE}.tif -# -# Script 20 creates: -# laravel_app/storage/app/{PROJECT}/field_tiles_CI/{FIELD}/{DATE}.tif -# laravel_app/storage/app/{PROJECT}/Data/extracted_ci/daily_vals/{FIELD}/{DATE}.rds -# -# Script 30 creates: -# laravel_app/storage/app/{PROJECT}/Data/extracted_ci/cumulative_vals/All_pivots_Cumulative_CI_quadrant_year_v2.rds -# -# Script 21 creates: -# laravel_app/storage/app/{PROJECT}/ci_data_for_python.csv -# -# Python 31 creates: -# laravel_app/storage/app/{PROJECT}/reports/kpis/field_stats/{PROJECT}_harvest_imminent_week_{WW}_{YYYY}.csv -# -# Script 40 creates: -# laravel_app/storage/app/{PROJECT}/weekly_mosaic/{FIELD}/{DATE}/week_{WW}_{YYYY}.tif -# -# Script 80 creates: -# laravel_app/storage/app/{PROJECT}/output/{PROJECT}_field_analysis_week{WW}_{YYYY}.xlsx -# laravel_app/storage/app/{PROJECT}/output/{PROJECT}_field_analysis_week{WW}_{YYYY}.rds -# -# Script 90/91 creates: -# laravel_app/storage/app/{PROJECT}/output/SmartCane_Report_week{WW}_{YYYY}.docx -# -# ============================================================================== - diff --git a/r_app/translations/translations.xlsx b/r_app/translations/translations.xlsx index 0306e69..27116f6 100644 Binary files a/r_app/translations/translations.xlsx and b/r_app/translations/translations.xlsx differ