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

feat: enhance rainfall plotting and add benchmark lines in CI reports

Browse source
This commit is contained in:
Timon 2026-03-18 14:55:27 +01:00
parent 084e01f0a0
commit 32cbf5c0db
3 changed files with 27 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
r_app/90_CI_report_with_kpis_agronomic_support.Rmd
View file

@ -1283,7 +1283,6 @@ tryCatch({
minus_2_ww <- get_week_year(as.Date(today) - lubridate::weeks(2)) minus_2_ww <- get_week_year(as.Date(today) - lubridate::weeks(2))
minus_3_ww <- get_week_year(as.Date(today) - lubridate::weeks(3)) minus_3_ww <- get_week_year(as.Date(today) - lubridate::weeks(3))
message(paste("Processing", nrow(AllPivots_merged), "fields for weeks:",
message(paste("Processing", nrow(AllPivots_merged), "fields for weeks:", message(paste("Processing", nrow(AllPivots_merged), "fields for weeks:",
current_ww$week, minus_1_ww$week, minus_2_ww$week, minus_3_ww$week)) current_ww$week, minus_1_ww$week, minus_2_ww$week, minus_3_ww$week))

7
r_app/90_rainfall_utils.R
View file

@ -273,6 +273,13 @@ rain_add_to_plot <- function(g, rain_joined, ci_type, x_var, y_max) {
scale_factor <- (y_max * 0.30) / max_cum_rain scale_factor <- (y_max * 0.30) / max_cum_rain
g + g +
ggplot2::geom_area(
data = rain_joined,
ggplot2::aes(x = .data[[x_var]], y = cum_rain_mm * scale_factor),
fill = "steelblue",
alpha = 0.15,
inherit.aes = FALSE
) +
ggplot2::geom_line( ggplot2::geom_line(
data = rain_joined, data = rain_joined,
ggplot2::aes(x = .data[[x_var]], y = cum_rain_mm * scale_factor), ggplot2::aes(x = .data[[x_var]], y = cum_rain_mm * scale_factor),

22
r_app/90_report_utils.R
View file

@ -533,6 +533,24 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
legend.title = ggplot2::element_text(size = 8), legend.title = ggplot2::element_text(size = 8),
legend.text = ggplot2::element_text(size = 8)) + legend.text = ggplot2::element_text(size = 8)) +
ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE)) 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 { } else {
# 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) {
@ -831,9 +849,9 @@ compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c
# Prepare data for both CI types # Prepare data for both CI types
data_prepared <- data_filtered %>% data_prepared <- data_filtered %>%
dplyr::ungroup() %>% # Ensure no existing groupings dplyr::ungroup() %>% # Ensure no existing groupings
dplyr::select(DAH, value, cumulative_CI, season) %>% dplyr::select(DAH, mean_rolling_10_days = value, cumulative_CI, season) %>%
tidyr::pivot_longer( tidyr::pivot_longer(
cols = c("value", "cumulative_CI"), cols = c("mean_rolling_10_days", "cumulative_CI"),
names_to = "ci_type", names_to = "ci_type",
values_to = "ci_value" values_to = "ci_value"
) %>% ) %>%