diff --git a/NEWS.md b/NEWS.md index 4f30cd1a..941ef230 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ * PPC "avg" functions (`ppc_scatter_avg()`, `ppc_error_scatter_avg()`, etc.) gain a `stat` argument to set the averaging function. (Suggestion of #348, @kruschke). * `ppc_error_scatter_avg_vs_x(x = some_expression)` labels the *x* axis with `some_expression`. +* Add `ppc_dots()` and `ppd_dots()` by @behramulukir (#357) +* Add `x` argument to `ppc_error_binned` by @behramulukir (#359) # bayesplot 1.13.0 diff --git a/R/ppc-errors.R b/R/ppc-errors.R index d038aa70..f53f869d 100644 --- a/R/ppc-errors.R +++ b/R/ppc-errors.R @@ -9,6 +9,7 @@ #' @template args-y-yrep #' @template args-group #' @template args-facet_args +#' @param x A numeric vector the same length as `y` to use as the x-axis variable. #' @param ... Currently unused. #' @param stat A function or a string naming a function for computing the #' posterior average. In both cases, the function should take a vector input and @@ -109,6 +110,10 @@ #' yrep_prop <- sweep(yrep, 2, trials, "/") #' #' ppc_error_binned(y_prop, yrep_prop[1:6, ]) +#' +#' # plotting against a covariate on x-axis +#' herd <- as.numeric(example_model$data$herd) +#' ppc_error_binned(y_prop, yrep_prop[1:6, ], x = herd) #' } #' NULL @@ -270,9 +275,6 @@ ppc_error_scatter_avg_grouped <- #' @rdname PPC-errors #' @export -#' @param x A numeric vector the same length as `y` to use as the x-axis -#' variable. -#' ppc_error_scatter_avg_vs_x <- function( y, yrep, @@ -312,6 +314,7 @@ ppc_error_scatter_avg_vs_x <- function( ppc_error_binned <- function(y, yrep, + x = NULL, ..., facet_args = list(), bins = NULL, @@ -319,7 +322,8 @@ ppc_error_binned <- alpha = 0.25) { check_ignored_arguments(...) - data <- ppc_error_binnned_data(y, yrep, bins = bins) + qx <- enquo(x) + data <- ppc_error_binnned_data(y, yrep, x = x, bins = bins) facet_layer <- if (nrow(yrep) == 1) { geom_ignore() } else { @@ -356,7 +360,7 @@ ppc_error_binned <- color = point_color ) + labs( - x = "Predicted proportion", + x = if (is.null(x)) "Predicted proportion" else as_label((qx)), y = "Average Errors \n (with 2SE bounds)" ) + bayesplot_theme_get() + @@ -454,10 +458,14 @@ error_avg_label <- function(stat = NULL) { # Data for binned errors plots -ppc_error_binnned_data <- function(y, yrep, bins = NULL) { +ppc_error_binnned_data <- function(y, yrep, x = NULL, bins = NULL) { y <- validate_y(y) yrep <- validate_predictions(yrep, length(y)) + if (!is.null(x)) { + x <- validate_x(x, y) + } + if (is.null(bins)) { bins <- n_bins(length(y)) } @@ -465,13 +473,24 @@ ppc_error_binnned_data <- function(y, yrep, bins = NULL) { errors <- compute_errors(y, yrep) binned_errs <- list() for (s in 1:nrow(errors)) { - binned_errs[[s]] <- - bin_errors( - ey = yrep[s, ], - r = errors[s, ], - bins = bins, - rep_id = s - ) + if (is.null(x)) { + binned_errs[[s]] <- + bin_errors( + ey = yrep[s, ], + r = errors[s, ], + bins = bins, + rep_id = s + ) + } else { + binned_errs[[s]] <- + bin_errors( + ey = x, + r = errors[s, ], + bins = bins, + rep_id = s + ) + } + } binned_errs <- dplyr::bind_rows(binned_errs) diff --git a/man/PPC-errors.Rd b/man/PPC-errors.Rd index 047590bf..a3aec9d8 100644 --- a/man/PPC-errors.Rd +++ b/man/PPC-errors.Rd @@ -63,6 +63,7 @@ ppc_error_scatter_avg_vs_x( ppc_error_binned( y, yrep, + x = NULL, ..., facet_args = list(), bins = NULL, @@ -120,8 +121,7 @@ posterior average. In both cases, the function should take a vector input and return a scalar statistic. The function name is displayed in the axis-label. Defaults to \code{"mean"}.} -\item{x}{A numeric vector the same length as \code{y} to use as the x-axis -variable.} +\item{x}{A numeric vector the same length as \code{y} to use as the x-axis variable.} } \value{ A ggplot object that can be further customized using the \strong{ggplot2} package. @@ -217,6 +217,10 @@ yrep <- posterior_predict(example_model) yrep_prop <- sweep(yrep, 2, trials, "/") ppc_error_binned(y_prop, yrep_prop[1:6, ]) + +# plotting against a covariate on x-axis +herd <- as.numeric(example_model$data$herd) +ppc_error_binned(y_prop, yrep_prop[1:6, ], x = herd) } } diff --git a/tests/testthat/_snaps/ppc-errors/ppc-error-binned-with-x.svg b/tests/testthat/_snaps/ppc-errors/ppc-error-binned-with-x.svg new file mode 100644 index 00000000..f2c45b8a --- /dev/null +++ b/tests/testthat/_snaps/ppc-errors/ppc-error-binned-with-x.svg @@ -0,0 +1,218 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3 +4 +5 +6 + + + + + +3 +4 +5 +6 + +-0.3 +-0.2 +-0.1 +0.0 +0.1 +0.2 +0.3 + + + + + + + + +-0.3 +-0.2 +-0.1 +0.0 +0.1 +0.2 +0.3 + + + + + + + +x +Average Errors + (with 2SE bounds) +ppc_error_binned (with x) + + diff --git a/tests/testthat/data-for-binomial.rda b/tests/testthat/data-for-binomial.rda index 49f18e4d..128a1e83 100644 Binary files a/tests/testthat/data-for-binomial.rda and b/tests/testthat/data-for-binomial.rda differ diff --git a/tests/testthat/test-ppc-errors.R b/tests/testthat/test-ppc-errors.R index 1b9d62e0..e7f0ad8f 100644 --- a/tests/testthat/test-ppc-errors.R +++ b/tests/testthat/test-ppc-errors.R @@ -52,6 +52,8 @@ test_that("ppc_error_binned returns ggplot object", { expect_gg(ppc_error_binned(y, Ey)) expect_gg(ppc_error_binned(y[1:5], Ey[, 1:5])) expect_gg(ppc_error_binned(rep(y, 2), cbind(Ey, Ey))) + expect_gg(ppc_error_binned(y, Ey, x = x)) + expect_gg(ppc_error_binned(rep(y, 2), cbind(Ey, Ey), x = rep(x, 2))) }) test_that("bin_errors works for edge cases", { @@ -150,4 +152,8 @@ test_that("ppc_error_binned renders correctly", { p_base <- ppc_error_binned(y, y_rep) vdiffr::expect_doppelganger("ppc_error_binned (default)", p_base) + + x <- rnorm(length(y), mean = 5) + p_base_x <- ppc_error_binned(y, y_rep, x = x) + vdiffr::expect_doppelganger("ppc_error_binned (with x)", p_base_x) })