merge changes from main tree

Merge remote-tracking branch 'origin/master' into fun-avg

# Conflicts:
#	NEWS.md

Author: tjmahr

.Rbuildignore

@@ -15,3 +15,4 @@ book/*
 docs/*
 Rplots.pdf
 ^\.github$
+^release-prep\.R$

.github/workflows/recheck.yaml

@@ -0,0 +1,21 @@
+on:
+  workflow_dispatch:
+    inputs:
+      which:
+        type: choice
+        description: Which dependents to check
+        options:
+          - strong
+          - most
+
+name: Reverse dependency check
+
+jobs:
+  revdep_check:
+    name: Reverse check ${{ inputs.which }} dependents
+    uses: r-devel/recheck/.github/workflows/recheck.yml@v1
+    with:
+      which: ${{ inputs.which }}
+      subdirectory: '' # set if your R package is in a subdir of the git repo
+      repository: '' # set to recheck an R package from another git repo
+      ref: '' # set to recheck a custom tag/branch from another repo

.gitignore

@@ -12,3 +12,4 @@ cran-comments.md
 revdep/*
 CRAN-RELEASE
 CRAN-SUBMISSION
+release-prep.R

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: bayesplot
 Type: Package
 Title: Plotting for Bayesian Models
-Version: 1.12.0.9000
-Date: 2025-04-09
+Version: 1.13.0.9000
+Date: 2025-06-18
 Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"), email = "jsg2201@columbia.edu"),
              person("Tristan", "Mahr", role = "aut", comment = c(ORCID = "0000-0002-8890-5116")),
              person("Paul-Christian", "Bürkner", role = "ctb"),
@@ -41,6 +41,7 @@ Imports:
     tidyselect,
     utils
 Suggests:
+    ggdist,
     ggfortify,
     gridExtra (>= 2.2.1),
     hexbin,

NAMESPACE

@@ -123,6 +123,7 @@ export(ppc_data)
 export(ppc_dens)
 export(ppc_dens_overlay)
 export(ppc_dens_overlay_grouped)
+export(ppc_dots)
 export(ppc_ecdf_overlay)
 export(ppc_ecdf_overlay_grouped)
 export(ppc_error_binned)
@@ -170,6 +171,7 @@ export(ppd_boxplot)
 export(ppd_data)
 export(ppd_dens)
 export(ppd_dens_overlay)
+export(ppd_dots)
 export(ppd_ecdf_overlay)
 export(ppd_freqpoly)
 export(ppd_freqpoly_grouped)

NEWS.md

@@ -1,10 +1,17 @@
 # bayesplot (development version)
 
-* Add possibility for left-truncation to `ppc_km_overlay()` and `ppc_km_overlay_grouped()` by @Sakuski
-* Added `ppc_loo_pit_ecdf()` by @TeemuSailynoja
 * 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`.
 
+# bayesplot 1.13.0
+
+* Add `ppc_loo_pit_ecdf()` by @TeemuSailynoja (#345)
+* Add possibility for left-truncation to `ppc_km_overlay()` and `ppc_km_overlay_grouped()` by @Sakuski (#347)
+* Give user control over extrapolation in `ppc_km_overlay()` and `ppc_km_overlay_grouped()` by @Sakuski (#353)
+* Allow passing `moment_match` via `...`  for loo functions by @n-kall (#351)
+* Skip some tests when missing Suggests by @MichaelChirico (#344)
+* Remove a test that will fail with next ggplot2 release (#356)
+
 # bayesplot 1.12.0
 
 * Expand checking workflows to more platforms by @andrjohns (#324)

R/mcmc-distributions.R

@@ -472,7 +472,7 @@ mcmc_violin <- function(
     }
   }
 
-  geom_args <- list(size = 0.5, na.rm = TRUE, alpha = alpha)
+  geom_args <- list(linewidth = 0.5, na.rm = TRUE, alpha = alpha)
   if (violin) {
     geom_args[["draw_quantiles"]] <- probs
   } else {

R/ppc-censoring.R

@@ -24,11 +24,12 @@
 #' @section Plot Descriptions:
 #' \describe{
 #'   \item{`ppc_km_overlay()`}{
-#'    Empirical CCDF estimates of each dataset (row) in `yrep` are overlaid,
-#'    with the Kaplan-Meier estimate (Kaplan and Meier, 1958) for `y` itself on
-#'    top (and in a darker shade). This is a PPC suitable for right-censored
-#'    `y`. Note that the replicated data from `yrep` is assumed to be
-#'    uncensored.
+#'   Empirical CCDF estimates of each dataset (row) in `yrep` are overlaid, with
+#'   the Kaplan-Meier estimate (Kaplan and Meier, 1958) for `y` itself on top
+#'   (and in a darker shade). This is a PPC suitable for right-censored `y`.
+#'   Note that the replicated data from `yrep` is assumed to be uncensored. Left
+#'   truncation (delayed entry) times for `y` can be specified using
+#'   `left_truncation_y`.
 #'   }
 #'   \item{`ppc_km_overlay_grouped()`}{
 #'    The same as `ppc_km_overlay()`, but with separate facets by `group`.
@@ -40,24 +41,33 @@
 #' @template reference-km
 #'
 #' @examples
+#' \donttest{
 #' color_scheme_set("brightblue")
-#' y <- example_y_data()
+#'
 #' # For illustrative purposes, (right-)censor values y > 110:
+#' y <- example_y_data()
 #' status_y <- as.numeric(y <= 110)
 #' y <- pmin(y, 110)
+#'
 #' # In reality, the replicated data (yrep) would be obtained from a
 #' # model which takes the censoring of y properly into account. Here,
 #' # for illustrative purposes, we simply use example_yrep_draws():
 #' yrep <- example_yrep_draws()
 #' dim(yrep)
-#' \donttest{
+#'
+#' # Overlay 25 curves
 #' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y)
-#' }
+#'
+#' # With extrapolation_factor = 1 (no extrapolation)
+#' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, extrapolation_factor = 1)
+#'
+#' # With extrapolation_factor = Inf (show all posterior predictive draws)
+#' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y, extrapolation_factor = Inf)
+#'
 #' # With separate facets by group:
 #' group <- example_group_data()
-#' \donttest{
 #' ppc_km_overlay_grouped(y, yrep[1:25, ], group = group, status_y = status_y)
-#' }
+#'
 #' # With left-truncation (delayed entry) times:
 #' min_vals <- pmin(y, apply(yrep, 2, min))
 #' left_truncation_y <- rep(0, length(y))
@@ -66,7 +76,6 @@
 #'   runif(sum(condition), min = 0.6, max = 0.99) * y[condition],
 #'   min_vals[condition] - 0.001
 #' )
-#' \donttest{
 #' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y,
 #'               left_truncation_y = left_truncation_y)
 #' }
@@ -78,15 +87,23 @@ NULL
 #'   be a numeric vector of the same length as `y` with values in \{0, 1\} (0 =
 #'   right censored, 1 = event).
 #' @param left_truncation_y Optional parameter that specifies left-truncation
-#'   (delayed entry) times for the observations from `y`. This must
-#'   be a numeric vector of the same length as `y`. If `NULL` (default),
-#'   no left-truncation is assumed.
+#'   (delayed entry) times for the observations from `y`. This must be a numeric
+#'   vector of the same length as `y`. If `NULL` (default), no left-truncation
+#'   is assumed.
+#' @param extrapolation_factor A numeric value (>=1) that controls how far the
+#'   plot is extended beyond the largest observed value in `y`. The default
+#'   value is 1.2, which corresponds to 20 % extrapolation. Note that all
+#'   posterior predictive draws may not be shown by default because of the
+#'   controlled extrapolation. To display all posterior predictive draws, set
+#'   `extrapolation_factor = Inf`.
+#'
 ppc_km_overlay <- function(
   y,
   yrep,
   ...,
   status_y,
   left_truncation_y = NULL,
+  extrapolation_factor = 1.2,
   size = 0.25,
   alpha = 0.7
 ) {
@@ -97,15 +114,25 @@ ppc_km_overlay <- function(
   suggested_package("ggfortify")
 
   if (!is.numeric(status_y) || length(status_y) != length(y) || !all(status_y %in% c(0, 1))) {
-    stop("`status_y` must be a numeric vector of 0s and 1s the same length as `y`.")
+    stop("`status_y` must be a numeric vector of 0s and 1s the same length as `y`.", call. = FALSE)
   }
 
   if (!is.null(left_truncation_y)) {
     if (!is.numeric(left_truncation_y) || length(left_truncation_y) != length(y)) {
-      stop("`left_truncation_y` must be a numeric vector of the same length as `y`.")
+      stop("`left_truncation_y` must be a numeric vector of the same length as `y`.", call. = FALSE)
     }
   }
 
+  if (extrapolation_factor < 1) {
+    stop("`extrapolation_factor` must be greater than or equal to 1.", call. = FALSE)
+  }
+  if (extrapolation_factor == 1.2) {
+    message(
+      "Note: `extrapolation_factor` now defaults to 1.2 (20%).\n",
+      "To display all posterior predictive draws, set `extrapolation_factor = Inf`."
+    )
+  }
+
   data <- ppc_data(y, yrep, group = status_y)
 
   # Modify the status indicator:
@@ -149,6 +176,10 @@ ppc_km_overlay <- function(
   fsf$is_y_size <- ifelse(fsf$is_y_color == "yrep", size, 1)
   fsf$is_y_alpha <- ifelse(fsf$is_y_color == "yrep", alpha, 1)
 
+  max_time_y <- max(y, na.rm = TRUE)
+  fsf <- fsf %>%
+    dplyr::filter(.data$is_y_color != "yrep" | .data$time <= max_time_y * extrapolation_factor)
+
   # Ensure that the observed data gets plotted last by reordering the
   # levels of the factor "strata"
   fsf$strata <- factor(fsf$strata, levels = rev(levels(fsf$strata)))
@@ -194,6 +225,7 @@ ppc_km_overlay_grouped <- function(
   ...,
   status_y,
   left_truncation_y = NULL,
+  extrapolation_factor = 1.2,
   size = 0.25,
   alpha = 0.7
 ) {
@@ -207,7 +239,8 @@ ppc_km_overlay_grouped <- function(
     status_y = status_y,
     left_truncation_y = left_truncation_y,
     size = size,
-    alpha = alpha
+    alpha = alpha,
+    extrapolation_factor = extrapolation_factor
   )
 
   p_overlay +

R/ppc-distributions.R

@@ -15,7 +15,7 @@
 #' @template args-pit-ecdf
 #' @param size,alpha Passed to the appropriate geom to control the appearance of
 #'   the predictive distributions.
-#' @param ... Currently unused.
+#' @param ... For dot plots, optional additional arguments to pass to [ggdist::stat_dots()].
 #'
 #' @template details-binomial
 #' @template return-ggplot-or-data
@@ -28,14 +28,19 @@
 #'    dataset (row) in `yrep`. For these plots `yrep` should therefore
 #'    contain only a small number of rows. See the **Examples** section.
 #'   }
+#'   \item{`ppc_dots()`}{
+#'    A dot plot plot is displayed for `y` and each dataset (row) in `yrep`.
+#'    For these plots `yrep` should therefore contain only a small number of rows.
+#'    See the **Examples** section. This function requires [ggdist::stat_dots] to be installed.
+#'    }
 #'   \item{`ppc_freqpoly_grouped()`}{
 #'    A separate frequency polygon is plotted for each level of a grouping
 #'    variable for `y` and each dataset (row) in `yrep`. For this plot
 #'    `yrep` should therefore contain only a small number of rows. See the
 #'    **Examples** section.
 #'   }
-#'   \item{`ppc_ecdf_overlay(), ppc_dens_overlay(),
-#'          ppc_ecdf_overlay_grouped(), ppc_dens_overlay_grouped()`}{
+#'   \item{`ppc_ecdf_overlay()`, `ppc_dens_overlay()`,
+#'          `ppc_ecdf_overlay_grouped()`, `ppc_dens_overlay_grouped()`}{
 #'    Kernel density or empirical CDF estimates of each dataset (row) in
 #'    `yrep` are overlaid, with the distribution of `y` itself on top
 #'    (and in a darker shade). When using `ppc_ecdf_overlay()` with discrete
@@ -80,7 +85,7 @@
 #' ppc_pit_ecdf(y, yrep, prob = 0.99, plot_diff = TRUE)
 #' }
 #'
-#' # for ppc_hist,dens,freqpoly,boxplot definitely use a subset yrep rows so
+#' # for ppc_hist,dens,freqpoly,boxplot,dots definitely use a subset yrep rows so
 #' # only a few (instead of nrow(yrep)) histograms are plotted
 #' ppc_hist(y, yrep[1:8, ])
 #' \donttest{
@@ -90,6 +95,9 @@
 #' # wizard hat plot
 #' color_scheme_set("blue")
 #' ppc_dens(y, yrep[200:202, ])
+#'
+#' # dot plot
+#' ppc_dots(y, yrep[1:8, ])
 #' }
 #'
 #' \donttest{
@@ -507,6 +515,45 @@ ppc_boxplot <-
       xaxis_title(FALSE)
   }
 
+#' @rdname PPC-distributions
+#' @export
+#' @template args-dots
+ppc_dots <-
+  function(y,
+           yrep,
+           ...,
+           binwidth = NA,
+           quantiles = NA,
+           freq = TRUE) {
+    check_ignored_arguments(..., ok_args = c("dotsize", "layout", "stackratio", "overflow"))
+
+    suggested_package("ggdist")
+
+    data <- ppc_data(y, yrep)
+
+    ggplot(data, mapping = set_hist_aes(
+      freq = freq,
+      fill = .data$is_y_label,
+      color = .data$is_y_label
+    )) +
+      ggdist::stat_dots(
+        binwidth = binwidth,
+        quantiles = quantiles,
+        ...
+      ) +
+      scale_fill_ppc() +
+      scale_color_ppc() +
+      facet_wrap_parsed("rep_label") +
+      force_axes_in_facets() +
+      bayesplot_theme_get() +
+      space_legend_keys() +
+      yaxis_text(FALSE) +
+      yaxis_title(FALSE) +
+      yaxis_ticks(FALSE) +
+      xaxis_title(FALSE) +
+      facet_text(FALSE) +
+      facet_bg(FALSE)
+  }
 
 #' @rdname PPC-distributions
 #' @export

R/ppc-loo.R

@@ -174,7 +174,7 @@ ppc_loo_pit_overlay <- function(y,
                                 adjust = 1,
                                 kernel = "gaussian",
                                 n_dens = 1024) {
-  check_ignored_arguments(...)
+  check_ignored_arguments(..., ok_args = list("moment_match"))
 
   data <-
     ppc_loo_pit_data(
@@ -333,7 +333,7 @@ ppc_loo_pit_qq <- function(y,
                            compare = c("uniform", "normal"),
                            size = 2,
                            alpha = 1) {
-  check_ignored_arguments(...)
+  check_ignored_arguments(..., ok_args = list("moment_match"))
 
   compare <- match.arg(compare)
   if (!is.null(pit)) {
@@ -409,7 +409,7 @@ ppc_loo_pit_ecdf <- function(y,
                              prob = .99,
                              plot_diff = FALSE,
                              interpolate_adj = NULL) {
-  check_ignored_arguments(...)
+  check_ignored_arguments(..., ok_args = list("moment_match"))
 
   if (!is.null(pit)) {
     inform("'pit' specified so ignoring 'y','yrep','lw' if specified.")
@@ -534,7 +534,7 @@ ppc_loo_intervals <-
            fatten = 2.5,
            linewidth = 1,
            order = c("index", "median")) {
-    check_ignored_arguments(...)
+    check_ignored_arguments(..., ok_args = list("moment_match"))
     y <- validate_y(y)
     order_by_median <- match.arg(order) == "median"
     if (!is.null(intervals)) {
@@ -626,7 +626,7 @@ ppc_loo_ribbon <-
            prob_outer = 0.9,
            alpha = 0.33,
            size = 0.25) {
-    check_ignored_arguments(...)
+    check_ignored_arguments(..., ok_args = list("moment_match"))
     y <- validate_y(y)
     if (!is.null(intervals)) {
       stopifnot(is.matrix(intervals), ncol(intervals) %in% c(3, 5))