From a0fd43471eac809fa4812b718de688aa221681e2 Mon Sep 17 00:00:00 2001 From: ishaan-arora-1 Date: Wed, 11 Mar 2026 02:37:46 +0530 Subject: [PATCH 1/2] Infer annotation aesthetics from the active ggplot2 theme Reference lines (e.g. the vertical zero-line in mcmc_intervals, the rhat=1 line in mcmc_rhat) previously used hardcoded colors like "gray90" that don't adapt when users switch ggplot2 themes. Added an internal annotation_style() helper that reads the active theme's gridline color and linewidth. When gridlines are present, the reference line inherits their color at double the major gridline width. When gridlines are blank (bayesplot's default), it falls back to the previous gray90/0.5 defaults so existing plots are unchanged. Closes #120 --- R/helpers-gg.R | 26 +++++++++++++++++++++++++- R/mcmc-diagnostics.R | 3 ++- R/mcmc-intervals.R | 9 ++++++--- 3 files changed, 33 insertions(+), 5 deletions(-) diff --git a/R/helpers-gg.R b/R/helpers-gg.R index 953a51d4..5aeaf0cc 100644 --- a/R/helpers-gg.R +++ b/R/helpers-gg.R @@ -10,8 +10,9 @@ #' @examples #' # Draw a vertical line at zero (or do nothing) #' xs <- -2:2 +#' style <- annotation_style() #' maybe_vertical_line <- if (0 > min(xs) && 0 < max(xs)) { -#' vline_0(color = "gray90", linewidth = 0.5) +#' vline_0(color = style$color, linewidth = style$linewidth) #' } else { #' geom_ignore() #' } @@ -75,6 +76,29 @@ force_x_axis_in_facets <- function() { ) } +# Derive annotation line aesthetics from the active theme's gridlines. +# When the theme has visible gridlines, the reference line inherits their +# color at twice the major gridline width. When gridlines are blank (e.g. +# bayesplot's default theme), falls back to a light gray. +annotation_style <- function() { + thm <- bayesplot_theme_get() + grid <- calc_element("panel.grid.major", thm) + if (inherits(grid, "element_blank") || is.null(grid)) { + return(list(color = "gray90", linewidth = 0.5)) + } + minor <- calc_element("panel.grid.minor", thm) + minor_lw <- if (!inherits(minor, "element_blank") && !is.null(minor$linewidth)) { + minor$linewidth + } else { + 0.125 + } + major_lw <- grid$linewidth %||% (minor_lw * 2) + list( + color = grid$colour %||% "gray90", + linewidth = major_lw * 2 + ) +} + no_legend_spacing <- function() { theme(legend.spacing.y = unit(0, "cm")) } diff --git a/R/mcmc-diagnostics.R b/R/mcmc-diagnostics.R index 2727928f..532dd076 100644 --- a/R/mcmc-diagnostics.R +++ b/R/mcmc-diagnostics.R @@ -154,8 +154,9 @@ mcmc_rhat <- function(rhat, ..., size = NULL) { bayesplot_theme_get() if (min(data$value) < 1) { + ref_style <- annotation_style() graph <- graph + - vline_at(1, color = "gray", linewidth = 1) + vline_at(1, color = ref_style$color, linewidth = ref_style$linewidth) } brks <- set_rhat_breaks(data$value) diff --git a/R/mcmc-intervals.R b/R/mcmc-intervals.R index 1ab9298a..3d6c87ee 100644 --- a/R/mcmc-intervals.R +++ b/R/mcmc-intervals.R @@ -222,8 +222,9 @@ mcmc_intervals <- function(x, x_lim[2] <- x_lim[2] + 0.05 * x_range # faint vertical line at zero if zero is within x_lim + ref_style <- annotation_style() layer_vertical_line <- if (0 > x_lim[1] && 0 < x_lim[2]) { - vline_0(color = "gray90", linewidth = 0.5) + vline_0(color = ref_style$color, linewidth = ref_style$linewidth) } else { geom_ignore() } @@ -338,8 +339,9 @@ mcmc_areas <- function(x, x_lim[1] <- x_lim[1] - 0.05 * x_range x_lim[2] <- x_lim[2] + 0.05 * x_range + ref_style <- annotation_style() layer_vertical_line <- if (0 > x_lim[1] && 0 < x_lim[2]) { - vline_0(color = "gray90", linewidth = 0.5) + vline_0(color = ref_style$color, linewidth = ref_style$linewidth) } else { geom_ignore() } @@ -501,8 +503,9 @@ mcmc_areas_ridges <- function(x, x_lim[1] <- x_lim[1] - 0.05 * x_range x_lim[2] <- x_lim[2] + 0.05 * x_range + ref_style <- annotation_style() layer_vertical_line <- if (0 > x_lim[1] && 0 < x_lim[2]) { - vline_0(color = "gray90", linewidth = 0.5) + vline_0(color = ref_style$color, linewidth = ref_style$linewidth) } else { geom_ignore() } From 08ddba531831acafdd84e2ce3a7c4eab78db0204 Mon Sep 17 00:00:00 2001 From: ishaan-arora-1 Date: Thu, 12 Mar 2026 00:03:30 +0530 Subject: [PATCH 2/2] Address review feedback on annotation_style() - Revert geom_ignore() example to keep it simple (no annotation_style call) - annotation_style() now checks panel.grid.major.x / minor.x first, then falls back to panel.grid.major / minor, so themes that only customise vertical gridlines are handled correctly - Accept fallback_color and fallback_linewidth arguments so callers can preserve their original hardcoded defaults when gridlines are blank - Make all diagnostic reference lines in mcmc_rhat() and mcmc_neff() theme-aware (including the dashed break lines, not just the rhat=1 line) - Add unit tests for annotation_style() covering fallback values, theme reading, and panel.grid.major.x preference - Add vdiffr visual tests for mcmc_intervals, mcmc_rhat, and mcmc_neff under theme_gray() to verify theme-aware annotation rendering --- R/helpers-gg.R | 41 +++-- R/mcmc-diagnostics.R | 13 +- .../mcmc-diagnostics/mcmc-neff-theme-gray.svg | 161 ++++++++++++++++++ .../mcmc-diagnostics/mcmc-rhat-theme-gray.svg | 103 +++++++++++ .../mcmc-intervals-theme-gray.svg | 84 +++++++++ tests/testthat/test-convenience-functions.R | 34 ++++ tests/testthat/test-mcmc-diagnostics.R | 17 ++ tests/testthat/test-mcmc-intervals.R | 12 ++ 8 files changed, 449 insertions(+), 16 deletions(-) create mode 100644 tests/testthat/_snaps/mcmc-diagnostics/mcmc-neff-theme-gray.svg create mode 100644 tests/testthat/_snaps/mcmc-diagnostics/mcmc-rhat-theme-gray.svg create mode 100644 tests/testthat/_snaps/mcmc-intervals/mcmc-intervals-theme-gray.svg diff --git a/R/helpers-gg.R b/R/helpers-gg.R index 5aeaf0cc..7ae07fcc 100644 --- a/R/helpers-gg.R +++ b/R/helpers-gg.R @@ -10,9 +10,8 @@ #' @examples #' # Draw a vertical line at zero (or do nothing) #' xs <- -2:2 -#' style <- annotation_style() #' maybe_vertical_line <- if (0 > min(xs) && 0 < max(xs)) { -#' vline_0(color = style$color, linewidth = style$linewidth) +#' vline_0(color = "gray90", linewidth = 0.5) #' } else { #' geom_ignore() #' } @@ -77,24 +76,44 @@ force_x_axis_in_facets <- function() { } # Derive annotation line aesthetics from the active theme's gridlines. -# When the theme has visible gridlines, the reference line inherits their -# color at twice the major gridline width. When gridlines are blank (e.g. -# bayesplot's default theme), falls back to a light gray. -annotation_style <- function() { +# +# Because every current call-site draws a *vertical* reference line we first +# inspect the axis-specific element (`panel.grid.major.x`) so that themes +# which only customise vertical gridlines are handled correctly, then fall +# back to the general `panel.grid.major`. +# +# @param fallback_color,fallback_linewidth Values returned when the resolved +# grid element is blank or NULL (i.e. the theme hides gridlines). Different +# plots historically used different hardcoded values, so callers can preserve +# backward-compatible defaults. +annotation_style <- function(fallback_color = "gray90", + fallback_linewidth = 0.5) { thm <- bayesplot_theme_get() - grid <- calc_element("panel.grid.major", thm) + + grid <- calc_element("panel.grid.major.x", thm) + if (inherits(grid, "element_blank") || is.null(grid)) { + grid <- calc_element("panel.grid.major", thm) + } + if (inherits(grid, "element_blank") || is.null(grid)) { - return(list(color = "gray90", linewidth = 0.5)) + return(list(color = fallback_color, linewidth = fallback_linewidth)) } - minor <- calc_element("panel.grid.minor", thm) - minor_lw <- if (!inherits(minor, "element_blank") && !is.null(minor$linewidth)) { + + minor <- calc_element("panel.grid.minor.x", thm) + if (inherits(minor, "element_blank") || is.null(minor)) { + minor <- calc_element("panel.grid.minor", thm) + } + + minor_lw <- if (!inherits(minor, "element_blank") && + !is.null(minor) && + !is.null(minor$linewidth)) { minor$linewidth } else { 0.125 } major_lw <- grid$linewidth %||% (minor_lw * 2) list( - color = grid$colour %||% "gray90", + color = grid$colour %||% fallback_color, linewidth = major_lw * 2 ) } diff --git a/R/mcmc-diagnostics.R b/R/mcmc-diagnostics.R index 532dd076..18261c1c 100644 --- a/R/mcmc-diagnostics.R +++ b/R/mcmc-diagnostics.R @@ -153,8 +153,9 @@ mcmc_rhat <- function(rhat, ..., size = NULL) { show.legend = TRUE) + bayesplot_theme_get() + ref_style <- annotation_style(fallback_color = "gray", fallback_linewidth = 1) + if (min(data$value) < 1) { - ref_style <- annotation_style() graph <- graph + vline_at(1, color = ref_style$color, linewidth = ref_style$linewidth) } @@ -165,9 +166,9 @@ mcmc_rhat <- function(rhat, ..., size = NULL) { diagnostic_points(size) + vline_at( brks[-1], - color = "gray", + color = ref_style$color, linetype = 2, - linewidth = 0.25) + + linewidth = ref_style$linewidth * 0.25) + labs(y = NULL, x = expression(hat(R))) + scale_fill_diagnostic("rhat") + scale_color_diagnostic("rhat") + @@ -238,6 +239,8 @@ mcmc_neff <- function(ratio, ..., size = NULL) { } breaks <- c(0, 0.1, 0.25, 0.5, 0.75, 1, additional_breaks) + ref_style <- annotation_style(fallback_color = "gray", fallback_linewidth = 1) + ggplot( data, mapping = aes( @@ -252,9 +255,9 @@ mcmc_neff <- function(ratio, ..., size = NULL) { diagnostic_points(size) + vline_at( c(0.1, 0.5, 1), - color = "gray", + color = ref_style$color, linetype = 2, - linewidth = 0.25) + + linewidth = ref_style$linewidth * 0.25) + labs(y = NULL, x = expression(N[eff]/N)) + scale_fill_diagnostic("neff") + scale_color_diagnostic("neff") + diff --git a/tests/testthat/_snaps/mcmc-diagnostics/mcmc-neff-theme-gray.svg b/tests/testthat/_snaps/mcmc-diagnostics/mcmc-neff-theme-gray.svg new file mode 100644 index 00000000..c64e3fce --- /dev/null +++ b/tests/testthat/_snaps/mcmc-diagnostics/mcmc-neff-theme-gray.svg @@ -0,0 +1,161 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0.1 +0.25 +0.5 +0.75 +1 +N +e +f +f + +N + + + + + + + + + + +N +e +f +f + +N +≤ +0.1 +N +e +f +f + +N +≤ +0.5 +N +e +f +f + +N +> +0.5 +mcmc_neff (theme_gray) + + diff --git a/tests/testthat/_snaps/mcmc-diagnostics/mcmc-rhat-theme-gray.svg b/tests/testthat/_snaps/mcmc-diagnostics/mcmc-rhat-theme-gray.svg new file mode 100644 index 00000000..bedc14cf --- /dev/null +++ b/tests/testthat/_snaps/mcmc-diagnostics/mcmc-rhat-theme-gray.svg @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.00 +1.05 +1.10 +R +^ + + + + + + + + + + +R +^ +≤ +1.05 +R +^ +≤ +1.1 +R +^ +> +1.1 +mcmc_rhat (theme_gray) + + diff --git a/tests/testthat/_snaps/mcmc-intervals/mcmc-intervals-theme-gray.svg b/tests/testthat/_snaps/mcmc-intervals/mcmc-intervals-theme-gray.svg new file mode 100644 index 00000000..63a16feb --- /dev/null +++ b/tests/testthat/_snaps/mcmc-intervals/mcmc-intervals-theme-gray.svg @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +V5 +V4 +V3 +V2 +V1 + + + + + + + + + + +-2 +-1 +0 +1 +2 +mcmc_intervals (theme_gray) + + diff --git a/tests/testthat/test-convenience-functions.R b/tests/testthat/test-convenience-functions.R index 7b197f27..dcff4725 100644 --- a/tests/testthat/test-convenience-functions.R +++ b/tests/testthat/test-convenience-functions.R @@ -178,6 +178,40 @@ test_that("yaxis_ticks returns correct theme object", { }) +# annotation_style -------------------------------------------------------- +test_that("annotation_style returns fallbacks when gridlines are blank", { + bayesplot_theme_set(theme_default()) + on.exit(bayesplot_theme_set(), add = TRUE) + + s <- annotation_style() + expect_equal(s$color, "gray90") + expect_equal(s$linewidth, 0.5) + + s2 <- annotation_style(fallback_color = "gray", fallback_linewidth = 1) + expect_equal(s2$color, "gray") + expect_equal(s2$linewidth, 1) +}) + +test_that("annotation_style reads gridline aesthetics from theme", { + bayesplot_theme_set(ggplot2::theme_gray()) + on.exit(bayesplot_theme_set(), add = TRUE) + + s <- annotation_style() + expect_true(is.character(s$color)) + expect_true(is.numeric(s$linewidth)) + expect_true(s$linewidth > 0) +}) + +test_that("annotation_style prefers panel.grid.major.x over panel.grid.major", { + custom <- ggplot2::theme_gray() + + ggplot2::theme(panel.grid.major.x = ggplot2::element_line(colour = "red", linewidth = 3)) + bayesplot_theme_set(custom) + on.exit(bayesplot_theme_set(), add = TRUE) + + s <- annotation_style() + expect_equal(s$color, "red") +}) + # overlay functions ------------------------------------------------------- test_that("overlay_function returns the correct object", { expect_error(overlay_function(), 'argument "fun" is missing') diff --git a/tests/testthat/test-mcmc-diagnostics.R b/tests/testthat/test-mcmc-diagnostics.R index 5e95f46b..d5ab5926 100644 --- a/tests/testthat/test-mcmc-diagnostics.R +++ b/tests/testthat/test-mcmc-diagnostics.R @@ -191,3 +191,20 @@ test_that("mcmc_acf_bar renders correctly", { p_lags <- mcmc_acf_bar(vdiff_dframe, lags = 5) vdiffr::expect_doppelganger("mcmc_acf_bar (lags)", p_lags) }) + +test_that("mcmc_rhat and mcmc_neff annotations inherit from theme gridlines", { + testthat::skip_on_cran() + testthat::skip_if_not_installed("vdiffr") + skip_on_r_oldrel() + + bayesplot_theme_set(ggplot2::theme_gray()) + on.exit(bayesplot_theme_set(), add = TRUE) + + rhats <- seq(from = 1, to = 1.20, length.out = 10) + p_rhat <- mcmc_rhat(rhats) + vdiffr::expect_doppelganger("mcmc_rhat (theme_gray)", p_rhat) + + neffs <- seq(from = 0, to = 1, length.out = 20) + p_neff <- mcmc_neff(neffs) + vdiffr::expect_doppelganger("mcmc_neff (theme_gray)", p_neff) +}) diff --git a/tests/testthat/test-mcmc-intervals.R b/tests/testthat/test-mcmc-intervals.R index 882109bd..bddeacae 100644 --- a/tests/testthat/test-mcmc-intervals.R +++ b/tests/testthat/test-mcmc-intervals.R @@ -255,3 +255,15 @@ test_that("mcmc_areas_ridges renders correctly", { p_size <- mcmc_areas_ridges(vdiff_dframe, border_size = 2) vdiffr::expect_doppelganger("mcmc_areas_ridges (size)", p_size) }) + +test_that("mcmc_intervals annotation inherits from theme gridlines", { + testthat::skip_on_cran() + testthat::skip_if_not_installed("vdiffr") + skip_on_r_oldrel() + + bayesplot_theme_set(ggplot2::theme_gray()) + on.exit(bayesplot_theme_set(), add = TRUE) + + p <- mcmc_intervals(vdiff_dframe) + vdiffr::expect_doppelganger("mcmc_intervals (theme_gray)", p) +})