diff --git a/R/helpers-shared.R b/R/helpers-shared.R
index 9128e0f0..34890feb 100644
--- a/R/helpers-shared.R
+++ b/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
+}
diff --git a/R/mcmc-distributions.R b/R/mcmc-distributions.R
index 0b7acc0e..6810ab35 100644
--- a/R/mcmc-distributions.R
+++ b/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
diff --git a/R/mcmc-intervals.R b/R/mcmc-intervals.R
index 24aa52f2..13687846 100644
--- a/R/mcmc-intervals.R
+++ b/R/mcmc-intervals.R
@@ -301,7 +301,8 @@ 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)
@@ -309,7 +310,8 @@ mcmc_areas <- function(x,
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)
diff --git a/R/ppc-distributions.R b/R/ppc-distributions.R
index 75bbe2b2..17568c0d 100644
--- a/R/ppc-distributions.R
+++ b/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() +
diff --git a/R/ppc-loo.R b/R/ppc-loo.R
index e9184cbe..71b25f63 100644
--- a/R/ppc-loo.R
+++ b/R/ppc-loo.R
@@ -141,7 +141,8 @@ NULL
#' calculated from the PIT values to the theoretical standard normal
#' quantiles.
#' @param trim Passed to [ggplot2::stat_density()].
-#' @template args-density-controls
+#' @param bw,adjust,kernel,n_dens Optional arguments passed to
+#' [stats::density()] to override the defaults.
#' @param boundary_correction For `ppc_loo_pit_overlay()`, when set to `TRUE`
#' (the default) the function will compute boundary corrected density values
#' via convolution and a Gaussian filter, also known as the reflection method
diff --git a/R/ppd-distributions.R b/R/ppd-distributions.R
index 0d597b1e..8a6ea5f5 100644
--- a/R/ppd-distributions.R
+++ b/R/ppd-distributions.R
@@ -37,29 +37,32 @@ ppd_data <- function(ypred, group = NULL) {
#' @rdname PPD-distributions
#' @export
ppd_dens_overlay <-
- function(ypred,
- ...,
- size = 0.25,
- alpha = 0.7,
- trim = FALSE,
- bw = "nrd0",
- adjust = 1,
- kernel = "gaussian",
- n_dens = 1024) {
- check_ignored_arguments(...)
+ function(ypred,
+ ...,
+ size = 0.25,
+ alpha = 0.7,
+ trim = FALSE,
+ bw = "nrd0",
+ adjust = 1,
+ kernel = "gaussian",
+ bounds = NULL,
+ n_dens = 1024) {
+ check_ignored_arguments(...)
+ bounds <- validate_density_bounds(bounds)
- data <- ppd_data(ypred)
- ggplot(data, mapping = aes(x = .data$value)) +
- overlay_ppd_densities(
+ data <- ppd_data(ypred)
+ ggplot(data, mapping = aes(x = .data$value)) +
+ overlay_ppd_densities(
mapping = aes(group = .data$rep_id, color = "ypred"),
linewidth = size,
alpha = alpha,
- trim = trim,
- bw = bw,
- adjust = adjust,
- kernel = kernel,
- n = n_dens
- ) +
+ trim = trim,
+ bw = bw,
+ adjust = adjust,
+ kernel = kernel,
+ bounds = bounds,
+ n = n_dens
+ ) +
scale_color_ppd(
values = get_color("m"),
guide = guide_legend( # in case user turns legend back on
@@ -117,24 +120,27 @@ ppd_ecdf_overlay <-
#' @rdname PPD-distributions
#' @export
ppd_dens <-
- function(ypred,
- ...,
- trim = FALSE,
- size = 0.5,
- alpha = 1) {
- check_ignored_arguments(...)
+ function(ypred,
+ ...,
+ trim = FALSE,
+ size = 0.5,
+ alpha = 1,
+ bounds = NULL) {
+ check_ignored_arguments(...)
+ bounds <- validate_density_bounds(bounds)
- data <- ppd_data(ypred)
- ggplot(data, mapping = aes(
- x = .data$value,
- color = "ypred",
- fill = "ypred"
- )) +
- geom_density(
- linewidth = size,
- alpha = alpha,
- trim = trim
- ) +
+ data <- ppd_data(ypred)
+ ggplot(data, mapping = aes(
+ x = .data$value,
+ color = "ypred",
+ fill = "ypred"
+ )) +
+ geom_density(
+ linewidth = size,
+ alpha = alpha,
+ trim = trim,
+ bounds = bounds
+ ) +
scale_color_ppd() +
scale_fill_ppd() +
bayesplot_theme_get() +
diff --git a/man-roxygen/args-density-controls.R b/man-roxygen/args-density-controls.R
index e49d8610..b560ed2a 100644
--- a/man-roxygen/args-density-controls.R
+++ b/man-roxygen/args-density-controls.R
@@ -1,3 +1,4 @@
-#' @param bw,adjust,kernel,n_dens Optional arguments passed to
-#' [stats::density()] to override default kernel density estimation
-#' parameters. `n_dens` defaults to `1024`.
+#' @param bw,adjust,kernel,n_dens,bounds Optional arguments passed to
+#' [stats::density()] (and `bounds` to [ggplot2::stat_density()]) to override
+#' default kernel density estimation parameters or truncate the density
+#' support. `n_dens` defaults to `1024`.
diff --git a/man/MCMC-distributions.Rd b/man/MCMC-distributions.Rd
index deff7e48..b4c62dc5 100644
--- a/man/MCMC-distributions.Rd
+++ b/man/MCMC-distributions.Rd
@@ -37,6 +37,7 @@ mcmc_dens(
adjust = NULL,
kernel = NULL,
n_dens = NULL,
+ bounds = NULL,
alpha = 1
)
@@ -65,7 +66,8 @@ mcmc_dens_overlay(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_dens_chains(
@@ -78,7 +80,8 @@ mcmc_dens_chains(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_dens_chains_data(
@@ -90,7 +93,8 @@ mcmc_dens_chains_data(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_violin(
@@ -177,9 +181,10 @@ function.)}
\item{trim}{A logical scalar passed to \code{\link[ggplot2:geom_density]{ggplot2::geom_density()}}.}
-\item{bw, adjust, kernel, n_dens}{Optional arguments passed to
-\code{\link[stats:density]{stats::density()}} to override default kernel density estimation
-parameters. \code{n_dens} defaults to \code{1024}.}
+\item{bw, adjust, kernel, n_dens, bounds}{Optional arguments passed to
+\code{\link[stats:density]{stats::density()}} (and \code{bounds} to \code{\link[ggplot2:geom_density]{ggplot2::stat_density()}}) to override
+default kernel density estimation parameters or truncate the density
+support. \code{n_dens} defaults to \code{1024}.}
\item{color_chains}{Option for whether to separately color chains.}
diff --git a/man/MCMC-intervals.Rd b/man/MCMC-intervals.Rd
index 804b5bd4..c0c1605a 100644
--- a/man/MCMC-intervals.Rd
+++ b/man/MCMC-intervals.Rd
@@ -40,7 +40,8 @@ mcmc_areas(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_areas_ridges(
@@ -55,7 +56,8 @@ mcmc_areas_ridges(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_intervals_data(
@@ -83,7 +85,8 @@ mcmc_areas_data(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
mcmc_areas_ridges_data(
@@ -97,7 +100,8 @@ mcmc_areas_ridges_data(
bw = NULL,
adjust = NULL,
kernel = NULL,
- n_dens = NULL
+ n_dens = NULL,
+ bounds = NULL
)
}
\arguments{
@@ -179,9 +183,10 @@ points across the curves are the same height. The method \code{"scaled height"}
\item{border_size}{For \code{mcmc_areas()} and \code{mcmc_areas_ridges()}, the size of
the ridgelines.}
-\item{bw, adjust, kernel, n_dens}{Optional arguments passed to
-\code{\link[stats:density]{stats::density()}} to override default kernel density estimation
-parameters. \code{n_dens} defaults to \code{1024}.}
+\item{bw, adjust, kernel, n_dens, bounds}{Optional arguments passed to
+\code{\link[stats:density]{stats::density()}} (and \code{bounds} to \code{\link[ggplot2:geom_density]{ggplot2::stat_density()}}) to override
+default kernel density estimation parameters or truncate the density
+support. \code{n_dens} defaults to \code{1024}.}
}
\value{
The plotting functions return a ggplot object that can be further
diff --git a/man/PPC-distributions.Rd b/man/PPC-distributions.Rd
index 628a3ad5..8a8416c5 100644
--- a/man/PPC-distributions.Rd
+++ b/man/PPC-distributions.Rd
@@ -30,6 +30,7 @@ ppc_dens_overlay(
bw = "nrd0",
adjust = 1,
kernel = "gaussian",
+ bounds = NULL,
n_dens = 1024
)
@@ -44,6 +45,7 @@ ppc_dens_overlay_grouped(
bw = "nrd0",
adjust = 1,
kernel = "gaussian",
+ bounds = NULL,
n_dens = 1024
)
@@ -68,7 +70,7 @@ ppc_ecdf_overlay_grouped(
alpha = 0.7
)
-ppc_dens(y, yrep, ..., trim = FALSE, size = 0.5, alpha = 1)
+ppc_dens(y, yrep, ..., trim = FALSE, size = 0.5, alpha = 1, bounds = NULL)
ppc_hist(
y,
@@ -167,9 +169,10 @@ the predictive distributions.}
\item{trim}{A logical scalar passed to \code{\link[ggplot2:geom_density]{ggplot2::geom_density()}}.}
-\item{bw, adjust, kernel, n_dens}{Optional arguments passed to
-\code{\link[stats:density]{stats::density()}} to override default kernel density estimation
-parameters. \code{n_dens} defaults to \code{1024}.}
+\item{bw, adjust, kernel, n_dens, bounds}{Optional arguments passed to
+\code{\link[stats:density]{stats::density()}} (and \code{bounds} to \code{\link[ggplot2:geom_density]{ggplot2::stat_density()}}) to override
+default kernel density estimation parameters or truncate the density
+support. \code{n_dens} defaults to \code{1024}.}
\item{discrete}{For \code{ppc_ecdf_overlay()}, should the data be treated as
discrete? The default is \code{FALSE}, in which case \code{geom="line"} is
diff --git a/man/PPC-loo.Rd b/man/PPC-loo.Rd
index 10f29d8c..555898d8 100644
--- a/man/PPC-loo.Rd
+++ b/man/PPC-loo.Rd
@@ -163,8 +163,7 @@ set to \code{TRUE} this parameter specifies the number of points used to
generate the estimations. This is set to 512 by default.}
\item{bw, adjust, kernel, n_dens}{Optional arguments passed to
-\code{\link[stats:density]{stats::density()}} to override default kernel density estimation
-parameters. \code{n_dens} defaults to \code{1024}.}
+\code{\link[stats:density]{stats::density()}} to override the defaults.}
\item{trim}{Passed to \code{\link[ggplot2:geom_density]{ggplot2::stat_density()}}.}
diff --git a/man/PPD-distributions.Rd b/man/PPD-distributions.Rd
index 6a3c2da4..32cf459e 100644
--- a/man/PPD-distributions.Rd
+++ b/man/PPD-distributions.Rd
@@ -24,6 +24,7 @@ ppd_dens_overlay(
bw = "nrd0",
adjust = 1,
kernel = "gaussian",
+ bounds = NULL,
n_dens = 1024
)
@@ -36,7 +37,7 @@ ppd_ecdf_overlay(
alpha = 0.7
)
-ppd_dens(ypred, ..., trim = FALSE, size = 0.5, alpha = 1)
+ppd_dens(ypred, ..., trim = FALSE, size = 0.5, alpha = 1, bounds = NULL)
ppd_hist(ypred, ..., binwidth = NULL, bins = NULL, breaks = NULL, freq = TRUE)
@@ -83,9 +84,10 @@ the predictive distributions.}
\item{trim}{A logical scalar passed to \code{\link[ggplot2:geom_density]{ggplot2::geom_density()}}.}
-\item{bw, adjust, kernel, n_dens}{Optional arguments passed to
-\code{\link[stats:density]{stats::density()}} to override default kernel density estimation
-parameters. \code{n_dens} defaults to \code{1024}.}
+\item{bw, adjust, kernel, n_dens, bounds}{Optional arguments passed to
+\code{\link[stats:density]{stats::density()}} (and \code{bounds} to \code{\link[ggplot2:geom_density]{ggplot2::stat_density()}}) to override
+default kernel density estimation parameters or truncate the density
+support. \code{n_dens} defaults to \code{1024}.}
\item{discrete}{For \code{ppc_ecdf_overlay()}, should the data be treated as
discrete? The default is \code{FALSE}, in which case \code{geom="line"} is
diff --git a/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-bounds.svg b/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-bounds.svg
new file mode 100644
index 00000000..b37559e9
--- /dev/null
+++ b/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-bounds.svg
@@ -0,0 +1,187 @@
+
+
diff --git a/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-overlay-bounds.svg b/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-overlay-bounds.svg
new file mode 100644
index 00000000..25560e06
--- /dev/null
+++ b/tests/testthat/_snaps/mcmc-distributions/mcmc-dens-overlay-bounds.svg
@@ -0,0 +1,102 @@
+
+
diff --git a/tests/testthat/_snaps/ppc-distributions/ppc-dens-overlay-bounds.svg b/tests/testthat/_snaps/ppc-distributions/ppc-dens-overlay-bounds.svg
new file mode 100644
index 00000000..6447bbf8
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-distributions/ppc-dens-overlay-bounds.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/ppc-distributions/ppd-dens-overlay-bounds.svg b/tests/testthat/_snaps/ppc-distributions/ppd-dens-overlay-bounds.svg
new file mode 100644
index 00000000..f72fea30
--- /dev/null
+++ b/tests/testthat/_snaps/ppc-distributions/ppd-dens-overlay-bounds.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/test-mcmc-distributions.R b/tests/testthat/test-mcmc-distributions.R
index 5a6f670a..109749c6 100644
--- a/tests/testthat/test-mcmc-distributions.R
+++ b/tests/testthat/test-mcmc-distributions.R
@@ -55,6 +55,36 @@ test_that("mcmc_dens_overlay returns a ggplot object", {
pars = c("(Intercept)", "beta[2]")))
})
+test_that("mcmc density plots accept bounds", {
+ suppressWarnings(expect_gg(mcmc_dens(arr, pars = "beta[1]", bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(mcmc_dens_overlay(arr, pars = "beta[1]", bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(mcmc_dens_chains(arr, pars = "beta[1]", bounds = c(0, Inf))))
+})
+
+test_that("mcmc density plots reject invalid bounds", {
+ # non-numeric bounds
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c("a", "b")),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds with length != 2
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c(0, 1, 2)),
+ "`bounds` must be a numeric vector of length 2")
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = 1),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds with NA values
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c(0, NA)),
+ "`bounds` must be a numeric vector of length 2")
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c(NA, 1)),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds where bounds[1] >= bounds[2]
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c(1, 0)),
+ "`bounds` must satisfy bounds\\[1\\] < bounds\\[2\\]")
+ expect_error(mcmc_dens(arr, pars = "beta[1]", bounds = c(1, 1)),
+ "`bounds` must satisfy bounds\\[1\\] < bounds\\[2\\]")
+})
+
test_that("mcmc_dens_chains returns a ggplot object", {
p <- mcmc_dens_chains(arr, pars = "beta[1]", regex_pars = "x\\:",
color_chains = FALSE)
@@ -143,6 +173,9 @@ test_that("mcmc_dens renders correctly", {
p_alpha <- mcmc_dens(vdiff_dframe, alpha = 0)
vdiffr::expect_doppelganger("mcmc_dens (alpha)", p_alpha)
+
+ p_bounds <- suppressWarnings(mcmc_dens(vdiff_dframe, bounds = c(0, Inf)))
+ suppressWarnings(vdiffr::expect_doppelganger("mcmc_dens (bounds)", p_bounds))
})
test_that("mcmc_dens_overlay renders correctly", {
@@ -152,6 +185,9 @@ test_that("mcmc_dens_overlay renders correctly", {
p_base <- mcmc_dens_overlay(vdiff_dframe_chains)
vdiffr::expect_doppelganger("mcmc_dens_overlay (default)", p_base)
+
+ p_bounds <- suppressWarnings(mcmc_dens_overlay(vdiff_dframe_chains, bounds = c(1,2)))
+ suppressWarnings(vdiffr::expect_doppelganger("mcmc_dens_overlay (bounds)", p_bounds))
})
test_that("mcmc_dens_chains renders correctly", {
diff --git a/tests/testthat/test-mcmc-intervals.R b/tests/testthat/test-mcmc-intervals.R
index e1794bf0..882109bd 100644
--- a/tests/testthat/test-mcmc-intervals.R
+++ b/tests/testthat/test-mcmc-intervals.R
@@ -61,6 +61,11 @@ test_that("mcmc_areas returns a ggplot object", {
expect_gg(mcmc_areas(dframe1))
})
+test_that("mcmc_areas and ridges accept bounds", {
+ expect_gg(mcmc_areas(arr, pars = "beta[1]", bounds = c(0, Inf)))
+ expect_gg(mcmc_areas_ridges(arr, pars = "beta[1]", bounds = c(0, Inf)))
+})
+
test_that("mcmc_areas_ridges returns a ggplot object", {
expect_gg(mcmc_areas_ridges(arr, pars = "beta[2]", regex_pars = "x\\:"))
expect_gg(mcmc_areas_ridges(arr1chain, regex_pars = c("beta", "x\\:")))
diff --git a/tests/testthat/test-ppc-distributions.R b/tests/testthat/test-ppc-distributions.R
index 5f7293c8..53870bcb 100644
--- a/tests/testthat/test-ppc-distributions.R
+++ b/tests/testthat/test-ppc-distributions.R
@@ -9,6 +9,38 @@ test_that("ppc_dens_overlay returns a ggplot object", {
expect_gg(ppd_dens_overlay(yrep2, size = 0.5, alpha = 0.2))
})
+test_that("density PPC/PPD plots accept bounds", {
+ suppressWarnings(expect_gg(ppc_dens(y, yrep[1:8, ], bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(ppc_dens_overlay(y, yrep, bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(ppc_dens_overlay_grouped(y, yrep, group = group, bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(ppd_dens(yrep[1:8, ], bounds = c(0, Inf))))
+ suppressWarnings(expect_gg(ppd_dens_overlay(yrep, bounds = c(0, Inf))))
+})
+
+test_that("density PPC/PPD plots reject invalid bounds", {
+ # non-numeric bounds
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c("a", "b")),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds with length != 2
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c(0, 1, 2)),
+ "`bounds` must be a numeric vector of length 2")
+ expect_error(ppc_dens_overlay(y, yrep, bounds = 1),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds with NA values
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c(0, NA)),
+ "`bounds` must be a numeric vector of length 2")
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c(NA, 1)),
+ "`bounds` must be a numeric vector of length 2")
+
+ # bounds where bounds[1] >= bounds[2]
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c(1, 0)),
+ "`bounds` must satisfy bounds\\[1\\] < bounds\\[2\\]")
+ expect_error(ppc_dens_overlay(y, yrep, bounds = c(1, 1)),
+ "`bounds` must satisfy bounds\\[1\\] < bounds\\[2\\]")
+})
+
test_that("ppc_ecdf_overlay returns a ggplot object", {
expect_gg(ppc_ecdf_overlay(y, yrep, size = 0.5, alpha = 0.2))
expect_gg(ppc_ecdf_overlay(y2, yrep2))
@@ -200,30 +232,30 @@ test_that("ppc_dots renders correctly", {
vdiffr::expect_doppelganger("ppc_dots (default)", p_base)
p_binwidth <- ppc_dots(vdiff_y, vdiff_yrep[1:8, ], binwidth = 3)
- expect_warning(vdiffr::expect_doppelganger("ppc_dots (binwidth)", p_binwidth),
- "The provided binwidth will cause dots to overflow the boundaries")
+ suppressWarnings(expect_warning(vdiffr::expect_doppelganger("ppc_dots (binwidth)", p_binwidth),
+ "The provided binwidth will cause dots to overflow the boundaries"))
p_quantile <- ppc_dots(vdiff_y, vdiff_yrep[1:8, ], quantiles = 50)
vdiffr::expect_doppelganger("ppc_dots (quantile)", p_quantile)
p_quantile_binwidth <- ppc_dots(vdiff_y, vdiff_yrep[1:8, ], binwidth = 3, quantiles = 50)
- expect_warning(vdiffr::expect_doppelganger("ppc_dots (quantile-binwidth)", p_quantile_binwidth),
- "The provided binwidth will cause dots to overflow the boundaries")
+ suppressWarnings(expect_warning(vdiffr::expect_doppelganger("ppc_dots (quantile-binwidth)", p_quantile_binwidth),
+ "The provided binwidth will cause dots to overflow the boundaries"))
# ppd versions
p_base <- ppd_dots(vdiff_yrep[1:8, ])
vdiffr::expect_doppelganger("ppd_dots (default)", p_base)
- p_binwidth <- ppd_dots(vdiff_yrep[1:8, ], binwidth = 3)
- expect_warning(vdiffr::expect_doppelganger("ppd_dots (binwidth)", p_binwidth),
- "The provided binwidth will cause dots to overflow the boundaries")
+ p_binwidth <- suppressWarnings(ppd_dots(vdiff_yrep[1:8, ], binwidth = 3))
+ suppressWarnings(expect_warning(vdiffr::expect_doppelganger("ppd_dots (binwidth)", p_binwidth),
+ "The provided binwidth will cause dots to overflow the boundaries"))
p_quantile <- ppd_dots(vdiff_yrep[1:8, ], quantiles = 50)
vdiffr::expect_doppelganger("ppd_dots (quantile)", p_quantile)
- p_quantile_binwidth <- ppd_dots(vdiff_yrep[1:8, ], binwidth = 3, quantiles = 50)
- expect_warning(vdiffr::expect_doppelganger("ppd_dots (quantile-binwidth)", p_quantile_binwidth),
- "The provided binwidth will cause dots to overflow the boundaries")
+ p_quantile_binwidth <- suppressWarnings(ppd_dots(vdiff_yrep[1:8, ], binwidth = 3, quantiles = 50))
+ suppressWarnings(expect_warning(vdiffr::expect_doppelganger("ppd_dots (quantile-binwidth)", p_quantile_binwidth),
+ "The provided binwidth will cause dots to overflow the boundaries"))
})
test_that("ppc_ecdf_overlay renders correctly", {
@@ -295,12 +327,18 @@ test_that("ppc_dens_overlay renders correctly", {
p_custom <- ppc_dens_overlay(vdiff_y, vdiff_yrep, size = 1, alpha = 0.2)
vdiffr::expect_doppelganger("ppc_dens_overlay (alpha, size)", p_custom)
+ p_bounds <- suppressWarnings(ppc_dens_overlay(vdiff_y, vdiff_yrep, bounds = c(0, Inf)))
+ suppressWarnings(vdiffr::expect_doppelganger("ppc_dens_overlay (bounds)", p_bounds))
+
# ppd versions
p_base <- ppd_dens_overlay(vdiff_yrep)
vdiffr::expect_doppelganger("ppd_dens_overlay (default)", p_base)
p_custom <- ppd_dens_overlay(vdiff_yrep, size = 1, alpha = 0.2)
vdiffr::expect_doppelganger("ppd_dens_overlay (alpha, size)", p_custom)
+
+ p_bounds <- suppressWarnings(ppd_dens_overlay(vdiff_yrep, bounds = c(0, Inf)))
+ suppressWarnings(vdiffr::expect_doppelganger("ppd_dens_overlay (bounds)", p_bounds))
})
test_that("ppc_dens_overlay_grouped renders correctly", {