Refactor translation handling by replacing tr_safe() with tr_key() and remove redundant tr_key() function definition
This commit is contained in:
parent
c9c5554fa3
commit
74aa881ec3
|
|
@ -498,20 +498,7 @@ tryCatch({
|
||||||
localisation <<- NULL
|
localisation <<- NULL
|
||||||
})
|
})
|
||||||
|
|
||||||
# Helper function to handle missing translation keys
|
# tr_key() is defined in 90_report_utils.R (sourced above)
|
||||||
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
|
# SHARED TREND MAPPING HELPER
|
||||||
|
|
|
||||||
|
|
@ -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))
|
cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' Safely look up a translation key with an English fallback.
|
#' Translate a key using the global `tr` vector, with an optional fallback.
|
||||||
#' Uses the global `tr` named vector built by the Rmd translation loader.
|
#' Unified replacement for the Rmd's tr_key() — covers both markdown text and
|
||||||
#' Supports {variable} placeholders resolved from the calling environment.
|
#' plot/map labels. Supports {variable} placeholders resolved from the caller.
|
||||||
tr_safe <- function(key, fallback) {
|
#' Falls back to `fallback` (if provided) or the key string itself when missing.
|
||||||
raw <- if (exists("tr", envir = globalenv()) && key %in% names(get("tr", envir = globalenv()))) {
|
tr_key <- function(key, fallback = NULL) {
|
||||||
get("tr", envir = globalenv())[[key]]
|
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 {
|
} else {
|
||||||
fallback
|
return(enc2utf8(as.character(key)))
|
||||||
}
|
}
|
||||||
|
|
||||||
result <- tryCatch(
|
result <- tryCatch(
|
||||||
glue::glue(raw, .envir = parent.frame()),
|
as.character(glue::glue(raw, .envir = parent.frame())),
|
||||||
error = function(e) as.character(raw)
|
error = function(e) as.character(raw)
|
||||||
)
|
)
|
||||||
# Convert literal \n (from Excel) to actual newlines
|
# Convert literal \n (as stored in Excel cells) to real newlines
|
||||||
gsub("\\n", "\n", as.character(result), fixed = TRUE)
|
enc2utf8(gsub("\\n", "\n", result, fixed = TRUE))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' Creates a Chlorophyll Index map for a pivot
|
#' 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)
|
outliers.trunc = c(TRUE, TRUE)
|
||||||
),
|
),
|
||||||
col.legend = tm_legend(
|
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",
|
orientation = if (legend_is_portrait) "portrait" else "landscape",
|
||||||
show = show_legend,
|
show = show_legend,
|
||||||
position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"),
|
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
|
# Add layout elements
|
||||||
age_days <- age * 7
|
age_days <- age * 7
|
||||||
map <- map + tm_layout(
|
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,
|
main.title.size = 0.7,
|
||||||
#legend.height = 0.85, # Constrain vertical legend height to not exceed map
|
#legend.height = 0.85, # Constrain vertical legend height to not exceed map
|
||||||
asp = 1 # Fixed aspect ratio
|
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)
|
outliers.trunc = c(TRUE, TRUE)
|
||||||
),
|
),
|
||||||
col.legend = tm_legend(
|
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",
|
orientation = if (legend_is_portrait) "portrait" else "landscape",
|
||||||
show = show_legend,
|
show = show_legend,
|
||||||
position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"),
|
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
|
# Add layout elements
|
||||||
age_days <- age * 7
|
age_days <- age * 7
|
||||||
map <- map + tm_layout(
|
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,
|
main.title.size = 0.7,
|
||||||
#legend.height = 0.85, # Constrain vertical legend height to not exceed map
|
#legend.height = 0.85, # Constrain vertical legend height to not exceed map
|
||||||
asp = 1 # Fixed aspect ratio
|
asp = 1 # Fixed aspect ratio
|
||||||
|
|
@ -363,7 +373,7 @@ ci_plot <- function(pivotName,
|
||||||
|
|
||||||
# Output heading and map to R Markdown
|
# Output heading and map to R Markdown
|
||||||
age_months <- round(age / 4.348, 1)
|
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)
|
print(tst)
|
||||||
|
|
||||||
}, error = function(e) {
|
}, 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))
|
data_ci2 <- data_ci2 %>% dplyr::mutate(season = as.factor(season))
|
||||||
|
|
||||||
# Resolved translated labels (used for y-axis labels and facet strip labels)
|
# 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")
|
rolling_mean_label <- tr_key("lbl_rolling_mean_ci", "10-Day Rolling Mean CI")
|
||||||
cumulative_label <- tr_safe("lbl_cumulative_ci", "Cumulative CI")
|
cumulative_label <- tr_key("lbl_cumulative_ci", "Cumulative CI")
|
||||||
|
|
||||||
# Compute benchmarks if requested and not provided
|
# Compute benchmarks if requested and not provided
|
||||||
if (show_benchmarks && is.null(benchmark_data)) {
|
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,
|
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)"),
|
"days" = if (facet_on) tr_key("lbl_date", "Date") else tr_key("lbl_age_of_crop_days", "Age of Crop (Days)"),
|
||||||
"weeks" = tr_safe("lbl_week_number", "Week Number"))
|
"weeks" = tr_key("lbl_week_number", "Week Number"))
|
||||||
|
|
||||||
# Calculate dynamic max values for breaks
|
# Calculate dynamic max values for breaks
|
||||||
max_dah <- max(plot_data$DAH, na.rm = TRUE) + 20
|
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"]]
|
group = .data[["sub_field"]]
|
||||||
)
|
)
|
||||||
) +
|
) +
|
||||||
ggplot2::labs(title = paste(tr_safe("lbl_plot_of", "Plot of"), y_label),
|
ggplot2::labs(title = paste(tr_key("lbl_plot_of", "Plot of"), y_label),
|
||||||
color = tr_safe("lbl_field_name", "Field Name"),
|
color = tr_key("lbl_field_name", "Field Name"),
|
||||||
y = y_label,
|
y = y_label,
|
||||||
x = x_label) +
|
x = x_label) +
|
||||||
ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y",
|
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(),
|
breaks = scales::breaks_pretty(),
|
||||||
labels = function(x) round(as.numeric(x - min(x)) / 30.44, 1))) +
|
labels = function(x) round(as.numeric(x - min(x)) / 30.44, 1))) +
|
||||||
ggplot2::theme_minimal() +
|
ggplot2::theme_minimal() +
|
||||||
|
|
@ -570,16 +580,16 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
|
||||||
),
|
),
|
||||||
linewidth = 1.5, alpha = 1
|
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),
|
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_safe("lbl_season", "Season"),
|
color = tr_key("lbl_season", "Season"),
|
||||||
y = y_label,
|
y = y_label,
|
||||||
x = x_label) +
|
x = x_label) +
|
||||||
color_scale +
|
color_scale +
|
||||||
{
|
{
|
||||||
if (x_var == "DAH") {
|
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") {
|
} 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() +
|
ggplot2::theme_minimal() +
|
||||||
|
|
@ -630,8 +640,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
|
||||||
}
|
}
|
||||||
|
|
||||||
x_label <- switch(x_unit,
|
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)"),
|
"days" = if (facet_on) tr_key("lbl_date", "Date") else tr_key("lbl_age_of_crop_days", "Age of Crop (Days)"),
|
||||||
"weeks" = tr_safe("lbl_week_number", "Week Number"))
|
"weeks" = tr_key("lbl_week_number", "Week Number"))
|
||||||
|
|
||||||
# Choose color palette based on colorblind_friendly flag
|
# Choose color palette based on colorblind_friendly flag
|
||||||
color_scale <- if (colorblind_friendly) {
|
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)
|
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
|
# 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
|
# Create the faceted plot
|
||||||
g_both <- ggplot2::ggplot(data = plot_data_both) +
|
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
|
linewidth = 1.5, alpha = 1
|
||||||
) +
|
) +
|
||||||
ggplot2::labs(title = both_plot_title,
|
ggplot2::labs(title = both_plot_title,
|
||||||
color = tr_safe("lbl_season", "Season"),
|
color = tr_key("lbl_season", "Season"),
|
||||||
y = tr_safe("lbl_ci_value", "CI Value"),
|
y = tr_key("lbl_ci_value", "CI Value"),
|
||||||
x = x_label) +
|
x = x_label) +
|
||||||
color_scale +
|
color_scale +
|
||||||
{
|
{
|
||||||
if (x_var == "DAH") {
|
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") {
|
} 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") {
|
} 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() +
|
ggplot2::theme_minimal() +
|
||||||
|
|
@ -776,13 +786,13 @@ cum_ci_plot2 <- function(pivotName){
|
||||||
midpoint_date <- start_date + (end_date - start_date) / 2
|
midpoint_date <- start_date + (end_date - start_date) / 2
|
||||||
|
|
||||||
# Pre-evaluate translated title here (not inside labs()) so {pivotName} resolves correctly
|
# 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() +
|
g <- ggplot() +
|
||||||
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
|
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
|
||||||
scale_y_continuous(limits = c(0, 4)) +
|
scale_y_continuous(limits = c(0, 4)) +
|
||||||
labs(title = fallback_title,
|
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_minimal() +
|
||||||
theme(axis.text.x = element_text(hjust = 0.5),
|
theme(axis.text.x = element_text(hjust = 0.5),
|
||||||
legend.justification = c(1, 0),
|
legend.justification = c(1, 0),
|
||||||
|
|
@ -790,7 +800,7 @@ cum_ci_plot2 <- function(pivotName){
|
||||||
legend.position.inside = c(1, 0),
|
legend.position.inside = c(1, 0),
|
||||||
legend.title = element_text(size = 8),
|
legend.title = element_text(size = 8),
|
||||||
legend.text = 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)
|
subchunkify(g, 3.2, 10)
|
||||||
|
|
||||||
|
|
|
||||||
Binary file not shown.
Loading…
Reference in a new issue