Merge branch 'master' into fix/remove-dead-code-464

Author: jgabry

NEWS.md

@@ -1,5 +1,6 @@
 # bayesplot (development version)
 
+* Standardize input validation errors in `ppc_km_overlay()` and interpolation helpers to use `rlang::abort()` for consistent error handling.
 * Fix assignment-in-call bug in `mcmc_rank_ecdf()` (#).
 * Replaced deprecated `dplyr` and `tidyselect` functions (`top_n`, `one_of`, `group_indices`) with their modern equivalents to ensure future compatibility. (#431)
 * Documentation added for all exported `*_data()` functions (#209)

R/helpers-ppc.R

@@ -456,7 +456,7 @@ interpolate_gamma <- function(N, K, prob, L) {
 get_interpolation_values <- function(N, K, L, prob) {
   for (dim in c("L", "prob")) {
     if (all(get(dim) != .gamma_adj[, dim])) {
-      stop(paste(
+      abort(paste(
         "No precomputed values to interpolate from for '", dim, "' = ",
         get(dim),
         ".\n",
@@ -469,7 +469,7 @@ get_interpolation_values <- function(N, K, L, prob) {
   }
   vals <- .gamma_adj[.gamma_adj$L == L & .gamma_adj$prob == prob, ]
   if (N > max(vals$N)) {
-    stop(paste(
+    abort(paste(
       "No precomputed values to interpolate from for sample length of ",
       N,
       ".\n",
@@ -480,7 +480,7 @@ get_interpolation_values <- function(N, K, L, prob) {
     ))
   }
   if (N < min(vals$N)) {
-    stop(paste(
+    abort(paste(
       "No precomputed values to interpolate from for sample length of ",
       N,
       ".\n",
@@ -491,7 +491,7 @@ get_interpolation_values <- function(N, K, L, prob) {
     ))
   }
   if (K > max(vals[vals$N <= N, ]$K)) {
-    stop(paste(
+    abort(paste(
       "No precomputed values available for interpolation for 'K' = ",
       K,
       ".\n",
@@ -502,7 +502,7 @@ get_interpolation_values <- function(N, K, L, prob) {
     ))
   }
   if (K < min(vals[vals$N <= N, ]$K)) {
-    stop(paste(
+    abort(paste(
       "No precomputed values available for interpolation for 'K' = ",
       K,
       ".\n",

R/mcmc-parcoord.R

@@ -132,8 +132,8 @@ mcmc_parcoord <-
 
 
     divg <- sym("Divergent")
-    draws <- dplyr::filter(data, UQ(divg) == 0)
-    div_draws <- dplyr::filter(data, UQ(divg) == 1)
+    draws <- dplyr::filter(data, !!divg == 0)
+    div_draws <- dplyr::filter(data, !!divg == 1)
     has_divs <- isTRUE(nrow(div_draws) > 0)
 
     graph <- ggplot(draws, aes(
@@ -191,7 +191,7 @@ mcmc_parcoord_data <-
       # 'Parameter' and 'Value' so need to be a little careful)
       divs <- np %>%
         validate_nuts_data_frame() %>%
-        dplyr::filter(UQ(param) == "divergent__") %>%
+        dplyr::filter(!!param == "divergent__") %>%
         select(- !!param) %>%
         rename("Divergent" = !!value)
 

R/mcmc-scatterplots.R

@@ -352,10 +352,10 @@ mcmc_pairs <- function(x,
     param <- sym("Parameter")
     val <- sym("Value")
     np <- validate_nuts_data_frame(np, lp)
-    divs <- dplyr::filter(np, UQ(param) == "divergent__") %>% pull(UQ(val))
+    divs <- dplyr::filter(np, !!param == "divergent__") %>% pull(!!val)
     divergent__ <- matrix(divs, nrow = n_iter * n_chain, ncol = n_param)[, 1]
     if (!no_max_td) {
-      gt_max_td <- (dplyr::filter(np, UQ(param) == "treedepth__") %>% pull(UQ(val))) >= max_treedepth
+      gt_max_td <- (dplyr::filter(np, !!param == "treedepth__") %>% pull(!!val)) >= max_treedepth
       max_td_hit__ <- matrix(gt_max_td, nrow = n_iter * n_chain, ncol = n_param)[, 1]
     }
   }
@@ -674,11 +674,11 @@ pairs_condition <- function(chains = NULL, draws = NULL, nuts = NULL) {
     divg <- sym("Divergent")
     xydata$Divergent <-
       np %>%
-      dplyr::filter(UQ(param) == "divergent__") %>%
-      pull(UQ(val))
+      dplyr::filter(!!param == "divergent__") %>%
+      pull(!!val)
 
-    divdata <- dplyr::filter(xydata, UQ(divg) == 1)
-    xydata <- dplyr::filter(xydata, UQ(divg) == 0)
+    divdata <- dplyr::filter(xydata, !!divg == 1)
+    xydata <- dplyr::filter(xydata, !!divg == 0)
   }
 
   graph <- ggplot(data = xydata, aes(x = .data$x, y = .data$y)) +
@@ -880,7 +880,7 @@ handle_condition <- function(x, condition=NULL, np=NULL, lp=NULL) {
 
     } else {
       param <- sym("Parameter")
-      mark <- dplyr::filter(np, UQ(param) == condition)
+      mark <- dplyr::filter(np, !!param == condition)
       mark <- unstack_to_matrix(mark, Value ~ Chain)
     }
     if (condition == "divergent__") {

R/mcmc-traces.R

@@ -789,7 +789,7 @@ divergence_rug <- function(np, np_style, n_iter, n_chain) {
     divg <- sym("Divergent")
 
     div_info <- np %>%
-      dplyr::filter(UQ(param) == "divergent__") %>%
+      dplyr::filter(!!param == "divergent__") %>%
       group_by(!! iter) %>%
       summarise(
         Divergent = ifelse(sum(!! val) > 0, !! iter, NA)

R/ppc-censoring.R

@@ -113,17 +113,17 @@ 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`.", call. = FALSE)
+    abort("`status_y` must be a numeric vector of 0s and 1s the same length as `y`.")
   }
 
   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)
+      abort("`left_truncation_y` must be a numeric vector of the same length as `y`.")
     }
   }
 
   if (extrapolation_factor < 1) {
-    stop("`extrapolation_factor` must be greater than or equal to 1.", call. = FALSE)
+    abort("`extrapolation_factor` must be greater than or equal to 1.")
   }
   if (extrapolation_factor == 1.2) {
     message(