Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Add translation handling functions and update titles in report generation

Browse source
This commit is contained in:
Timon 2026-03-09 17:19:54 +01:00
parent de9027434f
commit c9c5554fa3
4 changed files with 84 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
.claude/settings.local.json Normal file
View file

@ -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 \":*)"
]
}
}

111
r_app/90_report_utils.R
View file

@ -24,8 +24,25 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
"\n`","`` "\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))
} }
#' 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]]
} else {
fallback
}
result <- tryCatch(
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)
}
#' Creates a Chlorophyll Index map for a pivot #' Creates a Chlorophyll Index map for a pivot
#' #'
@ -74,7 +91,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 = "CI", title = tr_safe("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"),
@ -82,8 +99,9 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
) )
) )
# Add layout elements # Add layout elements
age_days <- age * 7
map <- map + tm_layout( map <- map + tm_layout(
main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), main.title = tr_safe("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
@ -151,7 +169,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 = "CI diff.", title = tr_safe("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"),
@ -159,8 +177,9 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
) )
) )
# Add layout elements # Add layout elements
age_days <- age * 7
map <- map + tm_layout( 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_safe("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
@ -344,7 +363,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(paste("## Field", pivotName, "-", age, "weeks/", age_months, "months after planting/harvest", field_heading_note, "\n\n")) cat(paste0("## ", tr_safe("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) {
@ -400,7 +419,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)) mean_rolling_10_days = zoo::rollapplyr(value, width = 10, FUN = mean, partial = TRUE))
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)
rolling_mean_label <- tr_safe("lbl_rolling_mean_ci", "10-Day Rolling Mean CI")
cumulative_label <- tr_safe("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)) {
benchmark_data <- compute_ci_benchmarks(ci_quadrant_data, estate_name, benchmark_percentiles) benchmark_data <- compute_ci_benchmarks(ci_quadrant_data, estate_name, benchmark_percentiles)
@ -411,8 +434,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
benchmark_data <- benchmark_data %>% benchmark_data <- benchmark_data %>%
dplyr::mutate( dplyr::mutate(
ci_type_label = case_when( ci_type_label = case_when(
ci_type == "value" ~ "10-Day Rolling Mean CI", ci_type == "value" ~ rolling_mean_label,
ci_type == "cumulative_CI" ~ "Cumulative CI", ci_type == "cumulative_CI" ~ cumulative_label,
TRUE ~ ci_type TRUE ~ ci_type
), ),
benchmark_label = paste0(percentile, "th Percentile") benchmark_label = paste0(percentile, "th Percentile")
@ -454,9 +477,9 @@ 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) "Date" else "Age of Crop (Days)", "days" = if (facet_on) tr_safe("lbl_date", "Date") else tr_safe("lbl_age_of_crop_days", "Age of Crop (Days)"),
"weeks" = "Week Number") "weeks" = tr_safe("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
max_week <- max(as.numeric(plot_data$week), na.rm = TRUE) + ceiling(20 / 7) max_week <- max(as.numeric(plot_data$week), na.rm = TRUE) + ceiling(20 / 7)
@ -473,12 +496,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("Plot of", y_label), ggplot2::labs(title = paste(tr_safe("lbl_plot_of", "Plot of"), y_label),
color = "Field Name", color = tr_safe("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 = "Age in Months", sec.axis = ggplot2::sec_axis(~ ., name = tr_safe("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() +
@ -547,16 +570,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("Plot of", y_label, "for Field", pivotName, title_suffix), ggplot2::labs(title = paste(tr_safe("lbl_plot_of", "Plot of"), y_label, tr_safe("lbl_for_field", "for Field"), pivotName, title_suffix),
color = "Season", color = tr_safe("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 = "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_safe("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 = "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_safe("lbl_age_in_months", "Age in Months"), breaks = seq(0, 14, by = 1)))
} }
} + } +
ggplot2::theme_minimal() + ggplot2::theme_minimal() +
@ -581,19 +604,19 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Generate plots based on plot_type # Generate plots based on plot_type
if (plot_type == "absolute") { 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) subchunkify(g, 2.8, 10)
} else if (plot_type == "cumulative") { } else if (plot_type == "cumulative") {
g <- create_plot("cumulative_CI", "Cumulative CI", "") g <- create_plot("cumulative_CI", cumulative_label, "")
subchunkify(g, 2.8, 10) subchunkify(g, 2.8, 10)
} else if (plot_type == "both") { } else if (plot_type == "both") {
# Create faceted plot with both CI types using pivot_longer approach # 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::filter(season %in% unique_seasons) %>%
dplyr::mutate( dplyr::mutate(
ci_type_label = case_when( ci_type_label = case_when(
ci_type == "mean_rolling_10_days" ~ "10-Day Rolling Mean CI", ci_type == "mean_rolling_10_days" ~ rolling_mean_label,
ci_type == "cumulative_CI" ~ "Cumulative CI", ci_type == "cumulative_CI" ~ cumulative_label,
TRUE ~ ci_type TRUE ~ ci_type
), ),
is_latest = season == latest_season # Flag for latest season is_latest = season == latest_season # Flag for latest season
@ -607,9 +630,9 @@ 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) "Date" else "Age of Crop (Days)", "days" = if (facet_on) tr_safe("lbl_date", "Date") else tr_safe("lbl_age_of_crop_days", "Age of Crop (Days)"),
"weeks" = "Week Number") "weeks" = tr_safe("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) {
ggplot2::scale_color_brewer(type = "qual", palette = "Set2") ggplot2::scale_color_brewer(type = "qual", palette = "Set2")
@ -620,7 +643,10 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Calculate dynamic max values for breaks # Calculate dynamic max values for breaks
max_dah_both <- max(plot_data_both$DAH, na.rm = TRUE) + 20 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) 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}")
# Create the faceted plot # Create the faceted plot
g_both <- ggplot2::ggplot(data = plot_data_both) + g_both <- ggplot2::ggplot(data = plot_data_both) +
# Add benchmark lines first (behind season lines) # Add benchmark lines first (behind season lines)
@ -636,8 +662,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
DAH DAH
}, },
ci_type_label = case_when( ci_type_label = case_when(
ci_type == "value" ~ "10-Day Rolling Mean CI", ci_type == "value" ~ rolling_mean_label,
ci_type == "cumulative_CI" ~ "Cumulative CI", ci_type == "cumulative_CI" ~ cumulative_label,
TRUE ~ ci_type TRUE ~ ci_type
) )
) )
@ -675,18 +701,18 @@ 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("CI Analysis for Field", pivotName), ggplot2::labs(title = both_plot_title,
color = "Season", color = tr_safe("lbl_season", "Season"),
y = "CI Value", y = tr_safe("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 = "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_safe("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 = "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_safe("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 = "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_safe("lbl_age_in_months", "Age in Months"), breaks = scales::breaks_pretty()))
} }
} + } +
ggplot2::theme_minimal() + ggplot2::theme_minimal() +
@ -707,7 +733,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 # Add invisible points to set the y-axis range for rolling mean facet
dummy_data <- data.frame( dummy_data <- data.frame(
ci_type_label = "10-Day Rolling Mean CI", ci_type_label = rolling_mean_label,
ci_value = c(0, 7), ci_value = c(0, 7),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
@ -749,11 +775,14 @@ cum_ci_plot2 <- function(pivotName){
date_seq <- seq.Date(from = start_date, to = end_date, by = "month") date_seq <- seq.Date(from = start_date, to = end_date, by = "month")
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
fallback_title <- tr_safe("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 = paste("14 day rolling MEAN CI rate - Field ", pivotName), labs(title = fallback_title,
x = "Date", y = "CI Rate") + x = tr_safe("lbl_date", "Date"), y = tr_safe("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),
@ -761,7 +790,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 = "No data available", size = 6, hjust = 0.5) annotate("text", x = midpoint_date, y = 2, label = tr_safe("lbl_no_data", "No data available"), size = 6, hjust = 0.5)
subchunkify(g, 3.2, 10) subchunkify(g, 3.2, 10)

4
r_app/MANUAL_PIPELINE_RUNNER.R
View file

@ -439,14 +439,14 @@
rmarkdown::render( rmarkdown::render(
"r_app/90_CI_report_with_kpis_agronomic_support.Rmd", "r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
params = list(data_dir = "aura", report_date = as.Date("2026-02-18"), language = "en" ), 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" output_dir = "laravel_app/storage/app/aura/reports"
) )
rmarkdown::render( rmarkdown::render(
"r_app/90_CI_report_with_kpis_agronomic_support.Rmd", "r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
params = list(data_dir = "aura", report_date = as.Date("2026-02-18"), language = "es" ), 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" output_dir = "laravel_app/storage/app/aura/reports"
) )
# #

BIN
r_app/translations/translations.xlsx
View file

Binary file not shown.