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..f4f8179 100644 --- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd +++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd @@ -498,20 +498,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)) - } -} +# tr_key() is defined in 90_report_utils.R (sourced above) # ============================================================================ # SHARED TREND MAPPING HELPER diff --git a/r_app/90_report_utils.R b/r_app/90_report_utils.R index ce7a99d..a748fb7 100644 --- a/r_app/90_report_utils.R +++ b/r_app/90_report_utils.R @@ -27,21 +27,31 @@ subchunkify <- function(g, fig_height=7, fig_width=5) { cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE)) } -#' Safely look up a translation key with an English fallback. -#' Uses the global `tr` named vector built by the Rmd translation loader. -#' Supports {variable} placeholders resolved from the calling environment. -tr_safe <- function(key, fallback) { - raw <- if (exists("tr", envir = globalenv()) && key %in% names(get("tr", envir = globalenv()))) { - get("tr", envir = globalenv())[[key]] +#' 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 { - fallback + return(enc2utf8(as.character(key))) } + result <- tryCatch( - glue::glue(raw, .envir = parent.frame()), + as.character(glue::glue(raw, .envir = parent.frame())), error = function(e) as.character(raw) ) - # Convert literal \n (from Excel) to actual newlines - gsub("\\n", "\n", as.character(result), fixed = TRUE) + # 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 @@ -91,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 = tr_safe("map_legend_ci_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"), @@ -101,7 +111,7 @@ 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 = tr_safe("map_title_max_ci", "Max CI week {week}\n{age} weeks ({age_days} 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 @@ -169,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 = tr_safe("map_legend_ci_diff", "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"), @@ -179,7 +189,7 @@ 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 = tr_safe("map_title_ci_change", "CI change week {week_1} - week {week_2}\n{age} weeks ({age_days} 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 @@ -363,7 +373,7 @@ ci_plot <- function(pivotName, # Output heading and map to R Markdown age_months <- round(age / 4.348, 1) - cat(paste0("## ", tr_safe("field_section_header", "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) { @@ -421,8 +431,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " 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_safe("lbl_rolling_mean_ci", "10-Day Rolling Mean CI") - cumulative_label <- tr_safe("lbl_cumulative_ci", "Cumulative CI") + 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)) { @@ -477,8 +487,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } x_label <- switch(x_unit, - "days" = if (facet_on) tr_safe("lbl_date", "Date") else tr_safe("lbl_age_of_crop_days", "Age of Crop (Days)"), - "weeks" = tr_safe("lbl_week_number", "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 @@ -496,12 +506,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " group = .data[["sub_field"]] ) ) + - ggplot2::labs(title = paste(tr_safe("lbl_plot_of", "Plot of"), y_label), - color = tr_safe("lbl_field_name", "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 = tr_safe("lbl_age_in_months", "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() + @@ -570,16 +580,16 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " ), linewidth = 1.5, alpha = 1 ) + - ggplot2::labs(title = paste(tr_safe("lbl_plot_of", "Plot of"), y_label, tr_safe("lbl_for_field", "for Field"), pivotName, title_suffix), - color = tr_safe("lbl_season", "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 = tr_safe("lbl_age_in_months", "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 = tr_safe("lbl_age_in_months", "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() + @@ -630,8 +640,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } x_label <- switch(x_unit, - "days" = if (facet_on) tr_safe("lbl_date", "Date") else tr_safe("lbl_age_of_crop_days", "Age of Crop (Days)"), - "weeks" = tr_safe("lbl_week_number", "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) { @@ -645,7 +655,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " 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_safe("lbl_ci_analysis_title", "CI Analysis for Field {pivotName}") + 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) + @@ -702,17 +712,17 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " linewidth = 1.5, alpha = 1 ) + ggplot2::labs(title = both_plot_title, - color = tr_safe("lbl_season", "Season"), - y = tr_safe("lbl_ci_value", "CI Value"), + 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 = tr_safe("lbl_age_in_months", "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 = tr_safe("lbl_age_in_months", "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 = tr_safe("lbl_age_in_months", "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() + @@ -776,13 +786,13 @@ cum_ci_plot2 <- function(pivotName){ midpoint_date <- start_date + (end_date - start_date) / 2 # Pre-evaluate translated title here (not inside labs()) so {pivotName} resolves correctly - fallback_title <- tr_safe("lbl_rolling_mean_fallback", "14 day rolling MEAN CI rate - Field {pivotName}") + 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_safe("lbl_date", "Date"), y = tr_safe("lbl_ci_rate", "CI Rate")) + + 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), @@ -790,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 = tr_safe("lbl_no_data", "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) diff --git a/r_app/translations/translations.xlsx b/r_app/translations/translations.xlsx index f82e112..ed311a5 100644 Binary files a/r_app/translations/translations.xlsx and b/r_app/translations/translations.xlsx differ