Merge branch 'master' into gh-pages

Author: jgabry

.Rbuildignore

@@ -18,3 +18,4 @@ tests/figs/*
 ^docs$
 ^_pkgdown\.yml$
 ^\.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
-Date: 2025-04-09
+Version: 1.13.0
+Date: 2025-06-18
 Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"), email = "jsg2201@columbia.edu"),
              person("Tristan", "Mahr", role = "aut"),
              person("Paul-Christian", "Bürkner", role = "ctb"),

NAMESPACE

@@ -144,6 +144,7 @@ export(ppc_km_overlay_grouped)
 export(ppc_loo_intervals)
 export(ppc_loo_pit)
 export(ppc_loo_pit_data)
+export(ppc_loo_pit_ecdf)
 export(ppc_loo_pit_overlay)
 export(ppc_loo_pit_qq)
 export(ppc_loo_ribbon)

NEWS.md

@@ -1,3 +1,12 @@
+# 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,23 +41,43 @@
 #' @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))
+#' condition <- y > mean(y) / 2
+#' left_truncation_y[condition] <- pmin(
+#'   runif(sum(condition), min = 0.6, max = 0.99) * y[condition],
+#'   min_vals[condition] - 0.001
+#' )
+#' ppc_km_overlay(y, yrep[1:25, ], status_y = status_y,
+#'               left_truncation_y = left_truncation_y)
 #' }
 NULL
 
@@ -65,11 +86,24 @@ NULL
 #' @param status_y The status indicator for the observations from `y`. This must
 #'   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.
+#' @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
 ) {
@@ -79,8 +113,25 @@ ppc_km_overlay <- function(
   suggested_package("survival")
   suggested_package("ggfortify")
 
-  stopifnot(is.numeric(status_y))
-  stopifnot(all(status_y %in% c(0, 1)))
+  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`.", 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`.", 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)
 
@@ -96,7 +147,12 @@ ppc_km_overlay <- function(
                                  as.numeric(as.character(.data$group)),
                                  1))
 
-  sf_form <- survival::Surv(value, group) ~ rep_label
+  if (is.null(left_truncation_y)) {
+    sf_form <- survival::Surv(time = data$value, event = data$group) ~ rep_label
+  } else {
+    sf_form <- survival::Surv(time = left_truncation_y[data$y_id], time2 = data$value, event = data$group) ~ rep_label
+  }
+
   if (!is.null(add_group)) {
     data <- dplyr::inner_join(data,
                               tibble::tibble(y_id = seq_along(y),
@@ -120,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)))
@@ -164,6 +224,8 @@ ppc_km_overlay_grouped <- function(
   group,
   ...,
   status_y,
+  left_truncation_y = NULL,
+  extrapolation_factor = 1.2,
   size = 0.25,
   alpha = 0.7
 ) {
@@ -175,8 +237,10 @@ ppc_km_overlay_grouped <- function(
     add_group = group,
     ...,
     status_y = status_y,
+    left_truncation_y = left_truncation_y,
     size = size,
-    alpha = alpha
+    alpha = alpha,
+    extrapolation_factor = extrapolation_factor
   )
 
   p_overlay +