# 90_REPORT_UTILS.R
# =============
# Utility functions for generating SmartCane reports with visualizations.
# These functions support the creation of maps, charts and report elements
# for the CI_report_dashboard_planet.Rmd document.

#' Creates a sub-chunk for use within RMarkdown documents
#'
#' @param g A ggplot object to render in the sub-chunk
#' @param fig_height Height of the figure in inches
#' @param fig_width Width of the figure in inches
#' @return NULL (writes chunk directly to output)
#'
subchunkify <- function(g, fig_height=7, fig_width=5) {
  g_deparsed <- paste0(deparse(
    function() {
      if (inherits(g, c("gtable", "grob", "gTree"))) {
        grid::grid.newpage()
        grid::grid.draw(g)
      } else {
        print(g)
      }
    }
  ), collapse = '\n')
  
  sub_chunk <- paste0("
`","``{r sub_chunk_", floor(runif(1) * 10000), ", fig.height=", fig_height, ", fig.width=", fig_width, ", dpi=300, dev='png', out.width='100%', echo=FALSE}",
                      "\n(",
                      g_deparsed
                      , ")()",
                      "\n`","``
  ")
  
  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
#'
#' @param pivot_raster The raster data containing CI values
#' @param pivot_shape The shape of the pivot field
#' @param pivot_spans Additional boundary data for the field
#' @param show_legend Whether to show the legend (default: FALSE)
#' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE)
#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom")
#' @param week Week number to display in the title
#' @param age Age of the crop in weeks
#' @param borders Whether to display field borders (default: FALSE)
#' @return A tmap object with the CI map
#' 
create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week, age, borders = FALSE, colorblind = FALSE){
  # Input validation
  if (missing(pivot_raster) || is.null(pivot_raster)) {
    stop("pivot_raster is required")
  }
  if (missing(pivot_shape) || is.null(pivot_shape)) {
    stop("pivot_shape is required")
  }
  if (missing(pivot_spans) || is.null(pivot_spans)) {
    stop("pivot_spans is required")
  }
  if (missing(week) || is.null(week)) {
    stop("week parameter is required")
  }
  if (missing(age) || is.null(age)) {
    stop("age parameter is required")
  }
  
  # Choose palette based on colorblind flag
  palette <- if (colorblind) "viridis" else "brewer.rd_yl_gn"
  
  # Create the base map
  map <- tm_shape(pivot_raster, unit = "m")
  
  # Add raster with continuous spectrum (fixed scale 8-1 for consistent comparison, reversed)
  map <- map + tm_raster(
    "CI",
    col.scale = tm_scale_continuous(
      values = palette,
      limits = c(1, 8),
      ticks = seq(1, 8, by = 1),
      outliers.trunc = c(TRUE, TRUE)
    ),
    col.legend = tm_legend(
      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"),
      reverse = TRUE
    )
  )
    # Add layout elements
  age_days <- age * 7
  map <- map + tm_layout(
    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
  )
  
  # Add borders if requested
  if (borders) {
    map <- map +
      tm_shape(pivot_shape) +
      tm_borders(lwd = 3) +
      tm_text("sub_field", size = 1/2) +
      tm_shape(pivot_spans) +
      tm_borders(lwd = 0.5, alpha = 0.5)
  }
  
  return(map)
}

#' Creates a Chlorophyll Index difference map between two weeks
#'
#' @param pivot_raster The raster data containing CI difference values
#' @param pivot_shape The shape of the pivot field
#' @param pivot_spans Additional boundary data for the field
#' @param show_legend Whether to show the legend (default: FALSE)
#' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE)
#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom")
#' @param week_1 First week number for comparison
#' @param week_2 Second week number for comparison
#' @param age Age of the crop in weeks
#' @param borders Whether to display field borders (default: TRUE)
#' @return A tmap object with the CI difference map
#'
create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week_1, week_2, age, borders = TRUE, colorblind = FALSE){
  # Input validation
  if (missing(pivot_raster) || is.null(pivot_raster)) {
    stop("pivot_raster is required")
  }
  if (missing(pivot_shape) || is.null(pivot_shape)) {
    stop("pivot_shape is required") 
  }
  if (missing(pivot_spans) || is.null(pivot_spans)) {
    stop("pivot_spans is required")
  }
  if (missing(week_1) || is.null(week_1) || missing(week_2) || is.null(week_2)) {
    stop("week_1 and week_2 parameters are required")
  }
  if (missing(age) || is.null(age)) {
    stop("age parameter is required")
  }
  
  # Choose palette based on colorblind flag
  palette <- if (colorblind) "plasma" else "brewer.rd_yl_gn"
  
  # Create the base map
  map <- tm_shape(pivot_raster, unit = "m")
  
  # Add raster with continuous spectrum (centered at 0 for difference maps, fixed scale, reversed)
  map <- map + tm_raster(
    "CI",
    col.scale = tm_scale_continuous(
      values = palette,
      limits = c(-3, 3),
      ticks = seq(-3, 3, by = 1),
      midpoint = 0,
      outliers.trunc = c(TRUE, TRUE)
    ),
    col.legend = tm_legend(
      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"),
      reverse = TRUE
    )
  )
    # Add layout elements
  age_days <- age * 7
  map <- map + tm_layout(
    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
  )
  
  # Add borders if requested
  if (borders) {
    map <- map +
      tm_shape(pivot_shape) +
      tm_borders(lwd = 3) +
      tm_text("sub_field", size = 1/2) +
      tm_shape(pivot_spans) +
      tm_borders(lwd = 0.5, alpha = 0.5)
  }
  
  return(map)
}

#' Creates a visualization of CI data for a specific pivot field
#'
#' @param pivotName The name or ID of the pivot field to visualize
#' @param field_boundaries Field boundaries spatial data (sf object)
#' @param current_ci Current week's Chlorophyll Index raster 
#' @param ci_minus_1 Previous week's Chlorophyll Index raster
#' @param ci_minus_2 Two weeks ago Chlorophyll Index raster
#' @param last_week_diff Difference raster between current and last week
#' @param three_week_diff Difference raster between current and three weeks ago
#' @param harvesting_data Data frame containing field harvesting/planting information
#' @param week Current week number
#' @param week_minus_1 Previous week number
#' @param week_minus_2 Two weeks ago week number
#' @param week_minus_3 Three weeks ago week number
#' @param borders Whether to display field borders (default: TRUE)
#' @param colorblind_friendly Whether to use colorblind-friendly color schemes (default: FALSE)
#' @return NULL (adds output directly to R Markdown document)
#'
ci_plot <- function(pivotName, 
                    field_boundaries = AllPivots0, 
                    current_ci = CI, 
                    ci_minus_1 = CI_m1, 
                    ci_minus_2 = CI_m2, 
                    last_week_diff = last_week_dif_raster_abs, 
                    three_week_diff = three_week_dif_raster_abs, 
                    harvesting_data = harvesting_data,
                    week = week,
                    week_minus_1 = week_minus_1,
                    week_minus_2 = week_minus_2,
                    week_minus_3 = week_minus_3,
                    borders = TRUE,
                    colorblind_friendly = FALSE){
  # Input validation
  if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
    stop("pivotName is required")
  }
  if (missing(field_boundaries) || is.null(field_boundaries)) {
    stop("field_boundaries is required")
  }
  if (missing(current_ci) || is.null(current_ci)) {
    stop("current_ci 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 %>% dplyr::filter(field %in% pivotName) %>% sf::st_transform(terra::crs(current_ci))
    age <- harvesting_data %>% 
           dplyr::filter(field %in% pivotName) %>% 
           sort("year") %>% 
           tail(., 1) %>% 
           dplyr::select(age) %>% 
           unique() %>% 
           pull() %>% 
           round()
    
    # Filter for the specific pivot
    AllPivots2 <- field_boundaries %>% dplyr::filter(field %in% pivotName)
    
    # Per-field mosaics are already cropped to field boundaries, so use directly without cropping
    singlePivot <- current_ci
    singlePivot_m1 <- ci_minus_1
    singlePivot_m2 <- ci_minus_2
    
    # Use difference maps directly (already field-specific)
    abs_CI_last_week <- last_week_diff
    abs_CI_three_week <- three_week_diff
    
    # Get planting date
    planting_date <- harvesting_data %>% 
                     dplyr::filter(field %in% pivotName) %>% 
                     ungroup() %>% 
                     dplyr::select(season_start) %>% 
                     unique()
    
    # Create spans for borders
    joined_spans2 <- field_boundaries %>% 
                     sf::st_transform(sf::st_crs(pivotShape)) %>% 
                     dplyr::filter(field %in% pivotName)
    
    # 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 historical maps only if data is available
    # Build list with all available maps - order matches original: [m2, m1, current, diff_1w, diff_3w]
    maps_to_arrange <- list()
    field_heading_note <- ""
    
    # Try to create 2-week ago map (legend on left)
    if (!is.null(singlePivot_m2)) {
      CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, 
                                show_legend = TRUE, legend_is_portrait = TRUE, 
                                legend_position = "left",
                                week = week_minus_2, age = age - 2, borders = borders, colorblind = colorblind_friendly)
      maps_to_arrange <- c(maps_to_arrange, list(CImap_m2))
    }
    
    # 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))
    }
    
    # Always add current week map (center position)
    maps_to_arrange <- c(maps_to_arrange, list(CImap))
    
    # 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))
    }
    
    # Try to create 3-week difference map (legend on right)
    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, 
                                                 legend_position = "right",
                                                 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))
    }
    
    # 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 in a row with more width for first and last (for legends)
    # Give maps with legends (1st and 5th) more space: 23%, middle maps get 18% each
    widths <- if (length(maps_to_arrange) == 5) {
      c(0.23, 0.18, 0.18, 0.18, 0.23)
    } else if (length(maps_to_arrange) == 4) {
      c(0.25, 0.25, 0.25, 0.25)  # Equal if only 4 maps
    } else if (length(maps_to_arrange) == 3) {
      c(0.33, 0.33, 0.34)  # Equal if only 3 maps
    } else if (length(maps_to_arrange) == 2) {
      c(0.5, 0.5)  # Equal if only 2 maps
    } else {
      NULL  # Single map or other cases
    }
    
    tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths)))
    
    # Output heading and map to R Markdown
    age_months <- round(age / 4.348, 1)
    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) {
    safe_log(paste("Error creating CI plot for pivot", pivotName, ":", e$message), "ERROR")
    cat(paste("# Field", pivotName, "- Error creating visualization", "\n\n"))
    cat(paste("Error:", e$message, "\n\n"))
  })
}

#' Creates a plot showing Chlorophyll Index data over time for a pivot field
#'
#' @param pivotName The name or ID of the pivot field to visualize
#' @param ci_quadrant_data Data frame containing CI quadrant data with field, sub_field, Date, DAH, cumulative_CI, value and season columns
#' @param plot_type Type of plot to generate: "absolute", "cumulative", or "both"
#' @param facet_on Whether to facet the plot by season (TRUE) or overlay all seasons (FALSE)
#' @param x_unit Unit for x-axis: "days" for DAH or "weeks" for week number (default: "days")
#' @param colorblind_friendly Whether to use colorblind-friendly color schemes (default: FALSE)
#' @param show_benchmarks Whether to show historical benchmark lines (default: FALSE)
#' @param estate_name Name of the estate for benchmark calculation (required if show_benchmarks = TRUE)
#' @param benchmark_percentiles Vector of percentiles for benchmarks (default: c(10, 50, 90))
#' @param rain_data data.frame(date, rain_mm) for this field's current season,
#'   as returned by rain_fetch_for_fields() / rain_join_to_ci(). NULL disables overlay.
#' @return NULL (adds output directly to R Markdown document)
#'
cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "absolute", facet_on = FALSE, x_unit = "days", colorblind_friendly = FALSE, show_benchmarks = FALSE, estate_name = NULL, benchmark_percentiles = c(10, 50, 90), benchmark_data = NULL, rain_data = NULL) {
  # Input validation
  if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
    stop("pivotName is required")
  }
  if (missing(ci_quadrant_data) || is.null(ci_quadrant_data)) {
    stop("ci_quadrant_data is required")
  }
  if (!plot_type %in% c("absolute", "cumulative", "both")) {
    stop("plot_type must be one of: 'absolute', 'cumulative', or 'both'")
  }
  if (!x_unit %in% c("days", "weeks")) {
    stop("x_unit must be either 'days' or 'weeks'")
  }
  
  # Filter data for the specified pivot
  tryCatch({
    data_ci <- ci_quadrant_data %>% dplyr::filter(field == pivotName)
    
    if (nrow(data_ci) == 0) {
      safe_log(paste("No CI data found for field", pivotName), "WARNING")
      return(cum_ci_plot2(pivotName))  # Use fallback function when no data is available
    }
    
    # Process data
    data_ci2 <- data_ci %>% 
      dplyr::mutate(CI_rate = cumulative_CI / DAH,
             week = lubridate::week(Date)) %>% 
      dplyr::group_by(field) %>%
      dplyr::mutate(mean_CIrate_rolling_10_days = zoo::rollapplyr(CI_rate, width = 10, FUN = mean, partial = TRUE),
             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)
    }
    
    # Prepare benchmark data for plotting if available
    if (!is.null(benchmark_data)) {
      benchmark_data <- benchmark_data %>%
        dplyr::mutate(
          ci_type_label = case_when(
            ci_type == "value" ~ rolling_mean_label,
            ci_type == "cumulative_CI" ~ cumulative_label,
            TRUE ~ ci_type
          ),
          benchmark_label = paste0(percentile, "th Percentile")
        )
      safe_log("Benchmark data prepared for plotting", "INFO")
    } else if (show_benchmarks) {
      safe_log("No benchmark data available", "WARNING")
    }
    data_ci3 <- tidyr::pivot_longer(
      data_ci2, 
      cols = c("mean_rolling_10_days", "cumulative_CI"),
      names_to = "ci_type",        # This column will say "mean_rolling_10_days" or "cumulative_CI"
      values_to = "ci_value"       # This column will have the numeric values
    )
    
    # Prepare date information by season
    date_preparation_perfect_pivot <- data_ci2 %>% 
      dplyr::group_by(season) %>% 
      dplyr::summarise(min_date = min(Date),
                max_date = max(Date),
                days = max_date - min_date)
    
    # Get the 3 most recent seasons
    unique_seasons <- sort(unique(date_preparation_perfect_pivot$season), decreasing = TRUE)[1:3]
    latest_season <- unique_seasons[1]  # Identify the latest season
    
    # Create plotting function that uses data_ci3 and filters by ci_type
    create_plot <- function(ci_type_filter, y_label, title_suffix) {
      # Filter data based on ci_type
      plot_data <- data_ci3 %>% 
        dplyr::filter(season %in% unique_seasons, ci_type == ci_type_filter) %>%
        dplyr::mutate(is_latest = season == latest_season)  # Flag for latest season
      
      # Determine x-axis variable based on x_unit parameter
      x_var <- if (x_unit == "days") {
        if (facet_on) "Date" else "DAH"
      } else {
        "week"
      }
      
      x_label <- switch(x_unit,
                       "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)
      
      # Create plot with either facets by season or overlay by DAH/week
      if (facet_on) {
        g <- ggplot2::ggplot(data = plot_data) +
          ggplot2::facet_wrap(~season, scales = "free_x") +
          ggplot2::geom_line(
            ggplot2::aes(
              x = .data[[x_var]],
              y = .data[["ci_value"]],
              col = .data[["sub_field"]],
              group = .data[["sub_field"]]
            )
          ) +
          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 = 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() +
              ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
                axis.text.x.top = ggplot2::element_text(hjust = 0.5),
                axis.title.x.top = ggplot2::element_text(size = 8),
                legend.justification = c(1, 0),
                legend.position = "inside",
                legend.position.inside = c(1, 0),
                legend.title = ggplot2::element_text(size = 8),
                legend.text = ggplot2::element_text(size = 8)) +
          ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))

        # Add benchmark lines to faceted plot (map DAH → Date per season)
        if (!is.null(benchmark_data) && ci_type_filter %in% benchmark_data$ci_type) {
          max_dah_clip <- max(plot_data$DAH, na.rm = TRUE) * 1.1
          benchmark_facet <- benchmark_data %>%
            dplyr::filter(ci_type == ci_type_filter, DAH <= max_dah_clip) %>%
            dplyr::cross_join(
              date_preparation_perfect_pivot %>%
                dplyr::filter(season %in% unique_seasons) %>%
                dplyr::select(season, min_date)
            ) %>%
            dplyr::mutate(Date = min_date + DAH - 1)
          g <- g + ggplot2::geom_smooth(
            data = benchmark_facet,
            ggplot2::aes(x = Date, y = benchmark_value, group = factor(percentile)),
            color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE, fullrange = FALSE
          )
        }
      } else {
        # Choose color palette based on colorblind_friendly flag
        color_scale <- if (colorblind_friendly) {
          ggplot2::scale_color_brewer(type = "qual", palette = "Set2")
        } else {
          ggplot2::scale_color_discrete()
        }
        
        g <- ggplot2::ggplot(data = plot_data) +
          # Add benchmark lines first (behind season lines)
          {
            if (!is.null(benchmark_data) && ci_type_filter %in% benchmark_data$ci_type) {
              # Clip benchmark to max DAH of plotted seasons + 10% buffer
              max_dah_clip <- max(plot_data$DAH, na.rm = TRUE) * 1.1
              benchmark_subset <- benchmark_data %>% 
                dplyr::filter(ci_type == ci_type_filter, DAH <= max_dah_clip) %>%
                dplyr::mutate(
                  benchmark_x = if (x_var == "DAH") {
                    DAH
                  } else if (x_var == "week") {
                    DAH / 7
                  } else {
                    DAH
                  }
                )
              ggplot2::geom_smooth(
                data = benchmark_subset,
                ggplot2::aes(
                  x = .data[["benchmark_x"]],
                  y = .data[["benchmark_value"]],
                  group = factor(.data[["percentile"]])
                ),
                color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE, fullrange = FALSE
              )
            }
          } +
          # Plot older seasons with lighter lines
          ggplot2::geom_line(
            data = plot_data %>% dplyr::filter(!is_latest),
            ggplot2::aes(
              x = .data[[x_var]],
              y = .data[["ci_value"]],
              col = .data[["season"]],
              group = .data[["season"]]
            ),
            linewidth = 0.7, alpha = 0.4
          ) +
          # Plot latest season with thicker, more prominent line
          ggplot2::geom_line(
            data = plot_data %>% dplyr::filter(is_latest),
            ggplot2::aes(
              x = .data[[x_var]],
              y = .data[["ci_value"]],
              col = .data[["season"]],
              group = .data[["season"]]
            ),
            linewidth = 1.5, alpha = 1
          ) +
          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") {
              # Dynamic breaks based on actual data range
              max_dah_plot <- max(plot_data$DAH, na.rm = TRUE)
              # Ensure the max value is included in breaks
              max_dah_plot <- max(plot_data$DAH, na.rm = TRUE)
              dah_breaks <- scales::pretty_breaks(n = 5)(c(0, max_dah_plot))
              # Month breaks: in secondary axis scale (month numbers 0, 1, 2, ...)
              n_months <- ceiling(max_dah_plot / 30.44)
              month_breaks <- seq(0, n_months, by = 1)
              ggplot2::scale_x_continuous(
                breaks = dah_breaks,
                sec.axis = ggplot2::sec_axis(
                  ~ . / 30.44,
                  name = tr_key("lbl_age_in_months", "Age in Months"),
                  breaks = month_breaks,
                  labels = function(x) as.integer(x)  # Show all month labels
                )
              )
            } else if (x_var == "week") {
              # Dynamic breaks based on actual data range
              max_week_plot <- max(as.numeric(plot_data$week), na.rm = TRUE)
              # Ensure the max value is included in breaks
              max_week_plot <- max(as.numeric(plot_data$week), na.rm = TRUE)
              week_breaks <- scales::pretty_breaks(n = 5)(c(0, max_week_plot))
              # Month breaks: in secondary axis scale (month numbers 0, 1, 2, ...)
              n_months <- ceiling(max_week_plot / 4.348)
              month_breaks <- seq(0, n_months, by = 1)
              ggplot2::scale_x_continuous(
                breaks = week_breaks,
                sec.axis = ggplot2::sec_axis(
                  ~ . / 4.348,
                  name = tr_key("lbl_age_in_months", "Age in Months"),
                  breaks = month_breaks,
                  labels = function(x) as.integer(x)  # Show all month labels
                )
              )
            }
          } +
          ggplot2::theme_minimal() +
              ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
                axis.text.x.top = ggplot2::element_text(hjust = 0.5),
                axis.title.x.top = ggplot2::element_text(size = 8),
                legend.justification = c(1, 0),
                legend.position = "inside",
                legend.position.inside = c(1, 0),
                legend.title = ggplot2::element_text(size = 8),
                legend.text = ggplot2::element_text(size = 8)) +
          ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
      }
      
      # Y-axis limits + optional rain overlay (single-panel plots)
      y_max <- if (ci_type_filter == "mean_rolling_10_days") {
        7
      } else {
        max(plot_data$ci_value, na.rm = TRUE) * 1.05
      }

      if (!is.null(rain_data)) {
        latest_ci_dates <- plot_data %>%
          dplyr::filter(is_latest) %>%
          dplyr::distinct(Date, DAH, week)
        rain_joined <- rain_join_to_ci(rain_data, latest_ci_dates)
        g <- rain_add_to_plot(g, rain_joined, ci_type_filter, x_var, y_max)
      } else {
        if (ci_type_filter == "mean_rolling_10_days") {
          g <- g + ggplot2::ylim(0, y_max)
        }
      }

      return(g)
    }
    
    # Generate plots based on plot_type
    if (plot_type == "absolute") {
      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_label, "")
      subchunkify(g, 2.8, 10)
    } else if (plot_type == "both") {
      # Build each panel independently so each gets its own secondary rain y-axis.
      # (facet_wrap + free_y does not support per-facet sec.axis in ggplot2.)
      both_plot_title <- tr_key("lbl_ci_analysis_title", "CI Analysis for Field {pivotName}")

      g_abs <- create_plot("mean_rolling_10_days", rolling_mean_label, "") +
        ggplot2::labs(title = rolling_mean_label) +
        ggplot2::theme(legend.position = "none")

      g_cum <- create_plot("cumulative_CI", cumulative_label, "") +
        ggplot2::labs(title = cumulative_label)

      combined <- gridExtra::arrangeGrob(g_abs, g_cum, ncol = 2, top = both_plot_title)

      subchunkify(combined, 2.8, 10)
    }
    
  }, error = function(e) {
    safe_log(paste("Error creating CI trend plot for pivot", pivotName, ":", e$message), "ERROR")
    cum_ci_plot2(pivotName)  # Use fallback function in case of error
  })
}

#' Fallback function for creating CI visualization when data is missing
#'
#' @param pivotName The name or ID of the pivot field to visualize
#' @return NULL (adds output directly to R Markdown document)
#'
cum_ci_plot2 <- function(pivotName){
  # Input validation
  if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
    stop("pivotName is required")
  }
  
  # Create a simple plot showing "No data available"
  tryCatch({
    end_date <- Sys.Date()
    start_date <- end_date %m-% months(11) # 11 months ago from end_date
    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 = 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),
        legend.position = "inside",
        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 = tr_key("lbl_no_data", "No data available"), size = 6, hjust = 0.5)
    
    subchunkify(g, 3.2, 10)
    
  }, error = function(e) {
    safe_log(paste("Error creating fallback CI plot for pivot", pivotName, ":", e$message), "ERROR")
    cat(paste("No data available for field", pivotName, "\n"))
  })
}

#' Gets the file path for a specific week's mosaic
#'
#' @param mosaic_path Base directory containing mosaic files
#' @param input_date Reference date to calculate from
#' @param week_offset Number of weeks to offset from input date (positive or negative)
#' @return File path to the requested week's mosaic TIF file
#'
get_week_path <- function(mosaic_path, input_date, week_offset) {
  # Input validation
  if (missing(mosaic_path) || is.null(mosaic_path) || mosaic_path == "") {
    stop("mosaic_path is required")
  }
  if (missing(input_date)) {
    stop("input_date is required")
  }
  
  tryCatch({
    # Convert input_date to Date object (in case it's a string)
    input_date <- as.Date(input_date)
    if (is.na(input_date)) {
      stop("Invalid input_date. Expected a Date object or a string convertible to Date.")
    }
    
    # Validate week_offset
    week_offset <- as.integer(week_offset)
    if (is.na(week_offset)) {
      stop("Invalid week_offset. Expected an integer value.")
    }
    
    # Get the start of the week for the input date (adjust to Monday as the start of the week)
    start_of_week <- lubridate::floor_date(input_date, unit = "week", week_start = 1)
    
    # Calculate the new date after applying the week offset
    target_date <- start_of_week + lubridate::weeks(week_offset)
    
    # Get the week number and year of the target date
    target_week <- sprintf("%02d", lubridate::isoweek(target_date))  # Left-pad week number with a zero if needed
    target_year <- lubridate::isoyear(target_date)
    
    # Load single-file mosaic for the given week
    path_to_week <- here::here(mosaic_path, paste0("week_", target_week, "_", target_year, ".tif"))
    
    # Log the path calculation
    safe_log(paste("Calculated path for week", target_week, "of year", target_year, ":", path_to_week), "INFO")
    
    # Return the path
    return(path_to_week)
    
  }, error = function(e) {
    safe_log(paste("Error calculating week path:", e$message), "ERROR")
    stop(e$message)
  })
}

#' Computes historical percentile benchmarks for CI data per estate
#'
#' @param ci_quadrant_data Data frame containing CI quadrant data with field, Date, DAH, cumulative_CI, value, season columns
#' @param estate_name Name of the estate/client to filter data for
#' @param percentiles Vector of percentiles to compute (e.g., c(10, 50, 90))
#' @param min_seasons Minimum number of seasons required for reliable benchmarks (default: 3)
#' @return Data frame with DAH, percentile, ci_type, benchmark_value, or NULL if insufficient data
#'
compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c(10, 50, 90), min_seasons = 3) {
  # Input validation
  if (missing(ci_quadrant_data) || is.null(ci_quadrant_data)) {
    stop("ci_quadrant_data is required")
  }
  if (missing(estate_name) || is.null(estate_name) || estate_name == "") {
    stop("estate_name is required")
  }
  if (!all(percentiles >= 0 & percentiles <= 100)) {
    stop("percentiles must be between 0 and 100")
  }
  
  tryCatch({
    # Filter data for the specified estate (assuming estate is not directly in data, but we can infer from context)
    # Since the data is per field, and fields are unique to estates, we'll use all data but could add estate filtering if available
    data_filtered <- ci_quadrant_data
    
    # Check if we have enough seasons
    unique_seasons <- unique(data_filtered$season)
    if (length(unique_seasons) < min_seasons) {
      safe_log(paste("Insufficient historical seasons for estate", estate_name, ":", length(unique_seasons), "seasons found, need at least", min_seasons), "WARNING")
      return(NULL)
    }
    
    # Prepare data for both CI types
    data_prepared <- data_filtered %>%
      dplyr::ungroup() %>%  # Ensure no existing groupings
      dplyr::select(DAH, mean_rolling_10_days = value, cumulative_CI, season) %>%
      tidyr::pivot_longer(
        cols = c("mean_rolling_10_days", "cumulative_CI"),
        names_to = "ci_type",
        values_to = "ci_value"
      ) %>%
      dplyr::filter(!is.na(ci_value))  # Remove NA values
    
    # Compute percentiles for each DAH and ci_type
    benchmarks <- data_prepared %>%
      dplyr::group_by(DAH, ci_type) %>%
      dplyr::summarise(
        p10 = tryCatch(quantile(ci_value, 0.1, na.rm = TRUE), error = function(e) NA_real_),
        p50 = tryCatch(quantile(ci_value, 0.5, na.rm = TRUE), error = function(e) NA_real_),
        p90 = tryCatch(quantile(ci_value, 0.9, na.rm = TRUE), error = function(e) NA_real_),
        n_observations = n(),
        .groups = 'drop'
      ) %>%
      dplyr::filter(n_observations >= min_seasons) %>%  # Only include DAHs with sufficient data
      tidyr::pivot_longer(
        cols = c(p10, p50, p90),
        names_to = "percentile",
        values_to = "benchmark_value"
      ) %>%
      dplyr::mutate(
        percentile = case_when(
          percentile == "p10" ~ 10,
          percentile == "p50" ~ 50,
          percentile == "p90" ~ 90
        )
      ) %>%
      dplyr::filter(!is.na(benchmark_value))  # Remove any NA benchmarks
    
    # Rename columns for clarity
    benchmarks <- benchmarks %>%
      dplyr::select(DAH, ci_type, percentile, benchmark_value)
    
    safe_log(paste("Computed CI benchmarks for estate", estate_name, "with", length(unique_seasons), "seasons and", nrow(benchmarks), "benchmark points"), "INFO")
    
    return(benchmarks)
    
  }, error = function(e) {
    safe_log(paste("Error computing CI benchmarks for estate", estate_name, ":", e$message), "ERROR")
    print(paste("DEBUG: Error details:", e$message, "Call:", deparse(e$call)))
    return(NULL)
  })
}

#' Aggregate per-field weekly mosaics into a farm-level mosaic
#'
#' Reads all per-field mosaic TIFs for a given week and merges them into a single farm-level mosaic.
#' This is used for overview maps in the report (Script 90).
#'
#' Per-field mosaics already have proper geospatial metadata (CRS, geotransform) from Script 10,
#' so terra can align them automatically without needing field boundaries or extent information.
#'
#' @param weekly_mosaic_dir Path to weekly_mosaic directory (e.g., "laravel_app/storage/app/{project}/weekly_mosaic")
#' @param target_week ISO week number (e.g., 52)
#' @param target_year ISO year (e.g., 2025)
#' @return SpatRaster object (5-band: R,G,B,NIR,CI) or NULL if no fields found
#'
#' @details
#' Per-field mosaics are located at: weekly_mosaic/{FIELD}/week_WW_YYYY.tif
#' This function:
#' 1. Finds all per-field subdirectories
#' 2. Loads each field's weekly mosaic
#' 3. Merges to a single raster using terra::mosaic() (alignment handled automatically by metadata)
#' 4. Returns combined 5-band raster for visualization
#'
aggregate_per_field_mosaics_to_farm_level <- function(
    weekly_mosaic_dir, 
    target_week, 
    target_year
) {
  
  tryCatch({
    
    # Validate directory exists
    if (!dir.exists(weekly_mosaic_dir)) {
      safe_log(paste("Weekly mosaic directory not found:", weekly_mosaic_dir), "WARNING")
      return(NULL)
    }
    
    # Find all per-field subdirectories (non-TIF files at top level)
    all_items <- list.files(weekly_mosaic_dir, full.names = FALSE)
    field_dirs <- all_items[
      !grepl("\\.tif$", all_items, ignore.case = TRUE) & 
      dir.exists(file.path(weekly_mosaic_dir, all_items))
    ]
    
    if (length(field_dirs) == 0) {
      safe_log(paste("No per-field directories found in", weekly_mosaic_dir), "WARNING")
      return(NULL)
    }
    
    safe_log(paste("Found", length(field_dirs), "field directories. Aggregating week", 
                   sprintf("%02d", target_week), target_year), "INFO")
    
    # Collect rasters from each field
    raster_list <- list()
    
    for (field_dir in field_dirs) {
      field_mosaic_path <- file.path(
        weekly_mosaic_dir, 
        field_dir, 
        paste0("week_", sprintf("%02d", target_week), "_", target_year, ".tif")
      )
      
      if (file.exists(field_mosaic_path)) {
        tryCatch({
          r <- terra::rast(field_mosaic_path)
          raster_list[[field_dir]] <- r
          safe_log(paste("Loaded mosaic for field:", field_dir), "DEBUG")
        }, error = function(e) {
          safe_log(paste("Could not load mosaic for field", field_dir, ":", e$message), "WARNING")
        })
      }
    }
    
    if (length(raster_list) == 0) {
      safe_log(paste("No field mosaics found for week", sprintf("%02d", target_week), target_year), "WARNING")
      return(NULL)
    }
    
    safe_log(paste("Successfully loaded mosaics for", length(raster_list), "fields"), "INFO")
    
    # Create a SpatRasterCollection and merge using correct terra syntax
    tryCatch({
      rsrc <- terra::sprc(raster_list)
      safe_log(paste("Created SpatRasterCollection with", length(raster_list), "rasters"), "DEBUG")
      
      # Merge the rasters into a single continuous raster (no overlap expected between fields)
      farm_mosaic <- terra::merge(rsrc)
      
      safe_log(paste("Aggregated", length(raster_list), "per-field mosaics into farm-level mosaic"), "INFO")
      
      # Verify mosaic was created successfully
      if (is.null(farm_mosaic)) {
        stop("merge() returned NULL")
      }
      
      return(farm_mosaic)
      
    }, error = function(e) {
      safe_log(paste("Error during mosaic creation:", e$message), "ERROR")
      return(NULL)
    })
    
  }, error = function(e) {
    safe_log(paste("Error aggregating per-field mosaics:", e$message), "ERROR")
    return(NULL)
  })
}


#' Get per-field mosaic path (new per-field architecture)
#'
#' Returns the path to a per-field weekly mosaic for direct visualization.
#' Replaces the old cropping workflow: now we load the field's own mosaic instead of cropping farm-level.
#'
#' @param weekly_mosaic_dir Path to weekly_mosaic directory
#' @param field_name Name of the field
#' @param target_week ISO week number
#' @param target_year ISO year
#' @return Path to field-specific mosaic TIF, or NULL if not found
#'
get_per_field_mosaic_path <- function(
    weekly_mosaic_dir, 
    field_name, 
    target_week, 
    target_year
) {
  
  path <- file.path(
    weekly_mosaic_dir, 
    field_name, 
    paste0("week_", sprintf("%02d", target_week), "_", target_year, ".tif")
  )
  
  if (file.exists(path)) {
    return(path)
  } else {
    safe_log(paste("Per-field mosaic not found for field", field_name, 
                   "week", sprintf("%02d", target_week), target_year), "WARNING")
    return(NULL)
  }
}

#' Determine field priority level based on CV and Moran's I
#'
#' @param cv Coefficient of Variation (uniformity metric)
#' @param morans_i Moran's I spatial autocorrelation index
#' @return Priority level: 1=Urgent, 2=Monitor, 3=No stress
#'
get_field_priority_level <- function(cv, morans_i) {
  # Handle NA values
  if (is.na(cv) || is.na(morans_i)) return(3)  # Default to no stress
  
  # Determine priority based on thresholds
  if (cv < 0.1) {
    if (morans_i < 0.7) {
      return(3)  # No stress
    } else if (morans_i <= 0.9) {
      return(2)  # Monitor (young field with some clustering)
    } else {
      return(1)  # Urgent
    }
  } else if (cv <= 0.15) {
    if (morans_i < 0.7) {
      return(2)  # Monitor
    } else {
      return(1)  # Urgent
    }
  } else {  # cv > 0.15
    return(1)  # Urgent
  }
}

#' Generate field-specific KPI summary for display in reports
#'
#' @param field_name Name of the field to summarize
#' @param field_details_table Data frame with field-level KPI details
#' @param CI_quadrant Data frame containing CI quadrant data with Date, DAH, season columns
#' @param report_date Report date (used for filtering current season data)
#' @return Formatted text string with field KPI summary
#'
generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant, report_date = Sys.Date()) {
  tryCatch({
    # Get field age from CI quadrant data for the CURRENT SEASON only
    # First identify the current season for this field
    # Get field age from CI quadrant data for the CURRENT SEASON only
    # First identify the current season for this field
    current_season_data <- CI_quadrant %>%
      filter(field == field_name, Date <= as.Date(report_date)) %>%
      group_by(season) %>%
      summarise(season_end = max(Date), .groups = 'drop') %>%
      filter(season == max(season))
    
    if (nrow(current_season_data) == 0) {
      return(paste("**Field", field_name, "KPIs:** No CI data available for current season"))
    }
    current_season <- current_season_data %>% pull(season)
    
    # Get the most recent DAH from the current season
    field_age_data <- CI_quadrant %>%
      filter(field == field_name, season == current_season) %>%
      pull(DAH)
    
    field_age <- if (length(field_age_data) > 0) max(field_age_data, na.rm = TRUE) else NA_real_    
    # Filter data for this specific field
    field_data <- field_details_table %>%
      filter(Field == field_name)
    
    if (nrow(field_data) == 0) {
      return(paste("**Field", field_name, "KPIs:** Data not available"))
    }
    
    # Aggregate sub-field data for field-level summary
    # For categorical data, take the most common value or highest risk level
    field_summary <- field_data %>%
      summarise(
        field_size = sum(`Field Size (acres)`, na.rm = TRUE),
        uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
        avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, 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_weed_risk = case_when(
          any(`Weed Risk` == "High") ~ "High",
          any(`Weed Risk` == "Moderate") ~ "Moderate",
          any(`Weed Risk` == "Low") ~ "Low",
          TRUE ~ "Unknown"
        ),
        avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
        avg_cv = mean(`CV Value`, na.rm = TRUE),
        .groups = 'drop'
      )
    
    # Apply age-based filtering to yield forecast
    if (is.na(field_age) || field_age < 240) {
      field_summary$avg_yield_forecast <- NA_real_
    }
    
    # Format the summary text
    yield_text <- if (is.na(field_summary$avg_yield_forecast)) {
      "Yield Forecast: NA"
    } else {
      paste0("Yield Forecast: ", round(field_summary$avg_yield_forecast, 1), " t/ha")
    }
    
    kpi_text <- paste0(
      "Size: ", round(field_summary$field_size * 0.404686, 1), " ha | Mean CI: ", round(field_summary$avg_mean_ci, 2),
      " | Growth Uniformity: ", field_summary$uniformity_levels, 
      " | ", yield_text, " | Gap Score: ", round(field_summary$max_gap_score, 1), 
      " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk
    )
    
    # Wrap in smaller text HTML tags for Word output
    kpi_text <- paste0("<span style='font-size:10pt'>", kpi_text, "</span>")
    
    return(kpi_text)
    
  }, error = function(e) {
    safe_log(paste("Error generating KPI summary for field", field_name, ":", e$message), "ERROR")
    return(paste("**Field", field_name, "KPIs:** Error generating summary"))
  })
}

#' Normalize field_details_table column structure
#'
#' 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).
#'
#' 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_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", "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|(?<!no\\s)\\bgrowth\\b|\\bincreasing\\b", text, perl = TRUE)) {
      arrow <- "↑";  trans_key <- "Slight growth"
    } else if (grepl("\\bstable\\b|\\bno growth\\b", text, perl = TRUE)) {
      arrow <- "→";  trans_key <- "Stable"
    } else if (grepl("\\b(?:weak|slight|moderate) decline\\b", text, perl = TRUE)) {
      arrow <- "↓";  trans_key <- "Slight decline"
    } else if (grepl("\\bstrong decline\\b|\\bsevere\\b", text, perl = TRUE)) {
      arrow <- "↓↓"; trans_key <- "Strong decline"
    } else {
      return(if (include_text) as.character(text) else "—")
    }

    label <- tr_key(trans_key)
    if (include_text) paste0(label, " (", arrow, ")") else arrow
  }, USE.NAMES = FALSE)
}

# ==============================================================================
# DATE / WEEK HELPERS
# ==============================================================================

#' Extract ISO week and year from a date
#'
#' Returns the ISO 8601 week number and the corresponding ISO year for a given
#' date.  Note that the ISO year may differ from the calendar year near
#' year-end boundaries (e.g. 2024-12-30 is ISO week 1 of 2025).
#'
#' @param date A \code{Date} object or a string coercible to \code{Date}.
#' @return A named list with elements:
#'   \describe{
#'     \item{\code{week}}{Integer ISO week number (1–53).}
#'     \item{\code{year}}{Integer ISO year.}
#'   }
#'
get_week_year <- function(date) {
  date <- as.Date(date)
  list(
    week = as.integer(format(date, "%V")),
    year = as.integer(format(date, "%G"))
  )
}

# ==============================================================================
# RASTER HELPERS
# ==============================================================================

#' Downsample a SpatRaster to a maximum cell count
#'
#' Reduces the resolution of a raster by integer aggregation when the number
#' of cells exceeds \code{max_cells}.  The aggregation factor is the smallest
#' integer that brings the cell count at or below the limit.
#'
#' @param r A \code{SpatRaster} object, or \code{NULL}.
#' @param max_cells Maximum number of cells to retain (default 2,000,000).
#' @param fun Aggregation function passed to \code{terra::aggregate()}
#'   (default \code{"mean"}).
#' @return The (possibly downsampled) \code{SpatRaster}, or \code{NULL} if
#'   \code{r} is \code{NULL}.
#'
downsample_raster <- function(r, max_cells = 2000000, fun = "mean") {
  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 = 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
}
