diff --git a/R/helpers-gg.R b/R/helpers-gg.R
index 21ec794a..59aead6c 100644
--- a/R/helpers-gg.R
+++ b/R/helpers-gg.R
@@ -68,6 +68,49 @@ force_x_axis_in_facets <- function() {
)
}
+# Derive annotation line aesthetics from the active theme's gridlines.
+#
+# 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.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 = fallback_color, linewidth = fallback_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 %||% fallback_color,
+ 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 f363026d..53bf7577 100644
--- a/R/mcmc-diagnostics.R
+++ b/R/mcmc-diagnostics.R
@@ -153,9 +153,11 @@ 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) {
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)
@@ -164,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") +
@@ -237,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(
@@ -251,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/R/mcmc-intervals.R b/R/mcmc-intervals.R
index 1d505fdb..03dfefe7 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()
}
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 @@
+
+
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 @@
+
+
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 @@
+
+
diff --git a/tests/testthat/test-convenience-functions.R b/tests/testthat/test-convenience-functions.R
index a6f76499..849e5531 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)
+})