Forward bounds argument

R/helpers-shared.R

@@ -44,3 +44,18 @@ check_ignored_arguments <- function(..., ok_args = character()) {
     }
   }
 }
+
+#' Validate bounds passed to stat_density/geom_density wrappers
+#' @noRd
+validate_density_bounds <- function(bounds) {
+  if (is.null(bounds)) {
+    return(NULL)
+  }
+  if (!is.numeric(bounds) || length(bounds) != 2 || anyNA(bounds)) {
+    abort("`bounds` must be a numeric vector of length 2.")
+  }
+  if (bounds[1] >= bounds[2]) {
+    abort("`bounds` must satisfy bounds[1] < bounds[2].")
+  }
+  bounds
+}

R/mcmc-distributions.R

@@ -151,6 +151,7 @@ mcmc_dens <- function(
   adjust = NULL,
   kernel = NULL,
   n_dens = NULL,
+  bounds = NULL,
   alpha = 1
 ) {
   check_ignored_arguments(...)
@@ -166,6 +167,7 @@ mcmc_dens <- function(
     adjust = adjust,
     kernel = kernel,
     n_dens = n_dens,
+    bounds = bounds,
     alpha = alpha,
     ...
   )
@@ -216,7 +218,8 @@ mcmc_dens_overlay <- function(
   bw = NULL,
   adjust = NULL,
   kernel = NULL,
-  n_dens = NULL
+  n_dens = NULL,
+  bounds = NULL
 ) {
   check_ignored_arguments(...)
   .mcmc_dens(
@@ -232,6 +235,7 @@ mcmc_dens_overlay <- function(
     adjust = adjust,
     kernel = kernel,
     n_dens = n_dens,
+    bounds = bounds,
     ...
   )
 }
@@ -250,7 +254,8 @@ mcmc_dens_chains <- function(
   bw = NULL,
   adjust = NULL,
   kernel = NULL,
-  n_dens = NULL
+  n_dens = NULL,
+  bounds = NULL
 ) {
   check_ignored_arguments(...)
   data <- mcmc_dens_chains_data(
@@ -261,7 +266,8 @@ mcmc_dens_chains <- function(
     bw = bw,
     adjust = adjust,
     kernel = kernel,
-    n_dens = n_dens
+    n_dens = n_dens,
+    bounds = bounds
   )
 
   n_chains <- length(unique(data$chain))
@@ -314,9 +320,11 @@ mcmc_dens_chains_data <- function(
   transformations = list(),
   ...,
   bw = NULL, adjust = NULL, kernel = NULL,
-  n_dens = NULL
+  n_dens = NULL,
+  bounds = NULL
 ) {
   check_ignored_arguments(...)
+  bounds <- validate_density_bounds(bounds)
 
   x %>%
     prepare_mcmc_array(
@@ -329,7 +337,8 @@ mcmc_dens_chains_data <- function(
       group_vars = c("Parameter", "Chain"),
       value_var = "Value",
       interval_width = 1,
-      bw = bw, adjust = adjust, kernel = kernel, n_dens = n_dens
+      bw = bw, adjust = adjust, kernel = kernel,
+      bounds = bounds, n_dens = n_dens
     ) %>%
     mutate(Chain = factor(.data$Chain)) %>%
     rlang::set_names(tolower) %>%
@@ -441,21 +450,23 @@ mcmc_violin <- function(
   color_chains = FALSE,
   geom = c("density", "violin"),
   probs = c(0.1, 0.5, 0.9),
-  trim = FALSE,
-  alpha = 1,
-  bw = NULL,
-  adjust = NULL,
-  kernel = NULL,
-  n_dens = NULL,
-  ...
-) {
+    trim = FALSE,
+    alpha = 1,
+    bw = NULL,
+    adjust = NULL,
+    kernel = NULL,
+    n_dens = NULL,
+    bounds = NULL,
+    ...
+  ) {
 
-  bw <- bw %||% "nrd0"
-  adjust <- adjust %||% 1
-  kernel <- kernel %||% "gaussian"
-  n_dens <- n_dens %||% 1024
+    bw <- bw %||% "nrd0"
+    adjust <- adjust %||% 1
+    kernel <- kernel %||% "gaussian"
+    n_dens <- n_dens %||% 1024
+    bounds <- validate_density_bounds(bounds)
 
-  x <- prepare_mcmc_array(x, pars, regex_pars, transformations)
+    x <- prepare_mcmc_array(x, pars, regex_pars, transformations)
   data <- melt_mcmc.mcmc_array(x)
   data$Chain <- factor(data$Chain)
   n_param <- num_params(data)
@@ -475,13 +486,16 @@ mcmc_violin <- function(
   geom_args <- list(linewidth = 0.5, na.rm = TRUE, alpha = alpha)
   if (violin) {
     geom_args[["draw_quantiles"]] <- probs
-  } else {
-    geom_args[["trim"]] <- trim
-    geom_args[["bw"]] <- bw
-    geom_args[["adjust"]] <- adjust
-    geom_args[["kernel"]] <- kernel
-    geom_args[["n"]] <- n_dens
-  }
+    } else {
+      geom_args[["trim"]] <- trim
+      geom_args[["bw"]] <- bw
+      geom_args[["adjust"]] <- adjust
+      geom_args[["kernel"]] <- kernel
+      geom_args[["n"]] <- n_dens
+      if (!is.null(bounds)) {
+        geom_args[["bounds"]] <- bounds
+      }
+    }
   if (by_chain) {
     # aes_mapping[["color"]] <- ~ Chain
     # aes_mapping[["group"]] <- ~ Chain

R/mcmc-intervals.R

@@ -301,15 +301,17 @@ mcmc_areas <- function(x,
                        bw = NULL,
                        adjust = NULL,
                        kernel = NULL,
-                       n_dens = NULL) {
+                       n_dens = NULL,
+                       bounds = NULL) {
   check_ignored_arguments(...)
   area_method <- match.arg(area_method)
 
   data <- mcmc_areas_data(
     x, pars, regex_pars, transformations,
     prob = prob, prob_outer = prob_outer,
     point_est = point_est, rhat = rhat,
-    bw = bw, adjust = adjust, kernel = kernel, n_dens = n_dens
+    bw = bw, adjust = adjust, kernel = kernel,
+    n_dens = n_dens, bounds = bounds
   )
   datas <- split(data, data$interval)
 
@@ -474,13 +476,14 @@ mcmc_areas_ridges <- function(x,
                              prob = 1,
                              border_size = NULL,
                              bw = NULL, adjust = NULL, kernel = NULL,
-                             n_dens = NULL) {
+                             n_dens = NULL,
+                             bounds = NULL) {
   check_ignored_arguments(...)
   data <- mcmc_areas_ridges_data(x, pars = pars, regex_pars = regex_pars,
                                  transformations = transformations,
                                  prob = prob, prob_outer = prob_outer,
                                  bw = bw, adjust = adjust, kernel = kernel,
-                                 n_dens = n_dens)
+                                 n_dens = n_dens, bounds = bounds)
 
   datas <- data %>%
     split(data$interval)
@@ -668,8 +671,10 @@ mcmc_areas_data <- function(x,
                             bw = NULL,
                             adjust = NULL,
                             kernel = NULL,
-                            n_dens = NULL) {
+                            n_dens = NULL,
+                            bounds = NULL) {
   probs <- check_interval_widths(prob, prob_outer)
+  bounds <- validate_density_bounds(bounds)
 
   # First compute normal intervals so we know the width of the data, point
   # estimates, and have prepared rhat values.
@@ -699,6 +704,7 @@ mcmc_areas_data <- function(x,
       bw = bw,
       adjust = adjust,
       kernel = kernel,
+      bounds = bounds,
       n_dens = n_dens) %>%
     mutate(interval = "inner")
 
@@ -710,6 +716,7 @@ mcmc_areas_data <- function(x,
       bw = bw,
       adjust = adjust,
       kernel = kernel,
+      bounds = bounds,
       n_dens = n_dens) %>%
     mutate(interval = "outer")
 
@@ -777,12 +784,14 @@ mcmc_areas_ridges_data <- function(x,
                                    prob = 1,
                                    bw = NULL,
                                    adjust = NULL, kernel = NULL,
-                                   n_dens = NULL) {
+                                   n_dens = NULL,
+                                   bounds = NULL) {
   check_ignored_arguments(...)
   mcmc_areas_data(x, pars = pars, regex_pars = regex_pars,
                   transformations = transformations,
                   prob = prob, prob_outer = prob_outer, point_est = "none",
-                  bw = bw, adjust = adjust, kernel = kernel, n_dens = n_dens)
+                  bw = bw, adjust = adjust, kernel = kernel,
+                  n_dens = n_dens, bounds = bounds)
 }
 
 
@@ -841,15 +850,24 @@ compute_column_density <- function(df, group_vars, value_var, ...) {
 
 # Given a vector of values, compute a density dataframe.
 compute_interval_density <- function(x, interval_width = 1, n_dens = 1024,
-                                     bw = NULL, adjust = NULL, kernel = NULL) {
+                                     bw = NULL, adjust = NULL, kernel = NULL,
+                                     bounds = NULL) {
   n_dens <- n_dens %||% 1024
 
   tail_width <- (1 - interval_width) / 2
   qs <- quantile(x, probs = c(tail_width, 1 - tail_width))
+  support <- range(qs)
+  if (!is.null(bounds)) {
+    support[1] <- max(bounds[1], support[1])
+    support[2] <- min(bounds[2], support[2])
+    if (!(support[1] < support[2])) {
+      support <- range(qs)
+    }
+  }
 
   args <- c(
     # can't be null
-    list(x = x, from = min(qs), to = max(qs), n = n_dens),
+    list(x = x, from = support[1], to = support[2], n = n_dens),
     # might be null
     bw = bw, adjust = adjust, kernel = kernel)
 

R/ppc-distributions.R

@@ -165,8 +165,10 @@ ppc_dens_overlay <-
            bw = "nrd0",
            adjust = 1,
            kernel = "gaussian",
+           bounds = NULL,
            n_dens = 1024) {
     check_ignored_arguments(...)
+    bounds <- validate_density_bounds(bounds)
 
     data <- ppc_data(y, yrep)
     ggplot(data, mapping = aes(x = .data$value)) +
@@ -179,6 +181,7 @@ ppc_dens_overlay <-
         bw = bw,
         adjust = adjust,
         kernel = kernel,
+        bounds = bounds,
         n = n_dens
       ) +
       overlay_ppd_densities(
@@ -190,6 +193,7 @@ ppc_dens_overlay <-
         bw = bw,
         adjust = adjust,
         kernel = kernel,
+        bounds = bounds,
         n = n_dens
       ) +
       scale_color_ppc() +
@@ -215,6 +219,7 @@ ppc_dens_overlay_grouped <- function(y,
                                      bw = "nrd0",
                                      adjust = 1,
                                      kernel = "gaussian",
+                                     bounds = NULL,
                                      n_dens = 1024) {
   check_ignored_arguments(...)
 
@@ -228,6 +233,7 @@ ppc_dens_overlay_grouped <- function(y,
     bw = bw,
     adjust = adjust,
     kernel = kernel,
+    bounds = bounds,
     n_dens = n_dens
   )
   # Use + list(data) trick to replace the data in the plot. The layer-specific
@@ -335,8 +341,10 @@ ppc_dens <-
            ...,
            trim = FALSE,
            size = 0.5,
-           alpha = 1) {
+           alpha = 1,
+           bounds = NULL) {
     check_ignored_arguments(...)
+    bounds <- validate_density_bounds(bounds)
     data <- ppc_data(y, yrep)
     ggplot(data, mapping = aes(
       x = .data$value,
@@ -346,7 +354,8 @@ ppc_dens <-
       geom_density(
         linewidth = size,
         alpha = alpha,
-        trim = trim
+        trim = trim,
+        bounds = bounds
       ) +
       scale_fill_ppc() +
       scale_color_ppc() +

R/ppc-loo.R

@@ -173,8 +173,10 @@ ppc_loo_pit_overlay <- function(y,
                                 trim = FALSE,
                                 adjust = 1,
                                 kernel = "gaussian",
+                                bounds = NULL,
                                 n_dens = 1024) {
   check_ignored_arguments(..., ok_args = list("moment_match"))
+  bounds <- validate_density_bounds(bounds)
 
   data <-
     ppc_loo_pit_data(
@@ -240,6 +242,7 @@ ppc_loo_pit_overlay <- function(y,
         bw = bw,
         adjust = adjust,
         kernel = kernel,
+        bounds = bounds,
         n = n_dens,
         na.rm = TRUE
       ) +
@@ -254,6 +257,7 @@ ppc_loo_pit_overlay <- function(y,
         bw = bw,
         adjust = adjust,
         kernel = kernel,
+        bounds = bounds,
         n = n_dens,
         na.rm = TRUE
       ) +