Infer annotation aesthetics from the active ggplot2 theme (#120)

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"))
 }

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") +

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()
   }