Replace sapply() with vapply() for type safety

NEWS.md

@@ -1,5 +1,6 @@
 # bayesplot (development version)
 
+* Replace 9 uses of `sapply()` with `vapply()` to enforce return types and prevent silent `list()` returns on zero-length input.
 * Added unit tests for `mcmc_areas_ridges_data()`, `mcmc_parcoord_data()`, and `mcmc_trace_data()`.
 * Added unit tests for `ppc_error_data()` and `ppc_loo_pit_data()` covering output structure, argument handling, and edge cases.
 * Added vignette sections demonstrating `*_data()` companion functions for building custom ggplot2 visualizations (#435)

R/bayesplot-extractors.R

@@ -145,7 +145,7 @@ nuts_params.stanreg <-
 #' @export
 #' @method nuts_params list
 nuts_params.list <- function(object, pars = NULL, ...) {
-  if (!all(sapply(object, is.matrix))) {
+  if (!all(vapply(object, is.matrix, logical(1)))) {
     abort("All list elements should be matrices.")
   }
 

R/bayesplot_grid.R

@@ -131,7 +131,7 @@ is_bayesplot_grid <- function(x) {
 }
 
 all_ggplot <- function(x) {
-  all(sapply(x, "inherits", what = "ggplot"))
+  all(vapply(x, inherits, logical(1), what = "ggplot"))
 }
 
 #' @export

R/helpers-mcmc.R

@@ -248,7 +248,7 @@ df_with_chain2array <- function(x) {
 #' @return TRUE or FALSE
 is_chain_list <- function(x) {
   check1 <- !is.data.frame(x) && is.list(x)
-  dims <- try(sapply(x, function(chain) length(dim(chain))), silent=TRUE)
+  dims <- try(vapply(x, function(chain) length(dim(chain)), integer(1)), silent=TRUE)
   if (inherits(dims, "try-error")) {
     return(FALSE)
   }
@@ -268,7 +268,7 @@ validate_chain_list <- function(x) {
     }
   }
   if (n_chain > 1) {
-    n_iter <- sapply(x, nrow)
+    n_iter <- vapply(x, nrow, integer(1))
     same_iters <- length(unique(n_iter)) == 1
     if (!same_iters) {
       abort("Each chain should have the same number of iterations.")
@@ -299,7 +299,7 @@ chain_list2array <- function(x) {
     n_iter <- nrow(x[[1]])
     param_names <- colnames(x[[1]])
   } else {
-    n_iter <- sapply(x, nrow)
+    n_iter <- vapply(x, nrow, integer(1))
     cnames <- sapply(x, colnames)
     param_names <- if (is.array(cnames))
       cnames[, 1] else cnames
@@ -434,7 +434,7 @@ apply_transformations.array <- function(x, ..., transformations = list()) {
 
 rename_transformed_pars <- function(pars, transformations) {
   stopifnot(is.character(pars), is.list(transformations))
-  has_names <- sapply(transformations, is.character)
+  has_names <- vapply(transformations, is.character, logical(1))
   if (any(has_names)) {
     nms <- names(which(has_names))
     for (nm in nms) {

R/mcmc-scatterplots.R

@@ -541,7 +541,7 @@ pairs_style_np <-
 pairs_condition <- function(chains = NULL, draws = NULL, nuts = NULL) {
   .ignore_args <- function(..., why = NULL) {
     dots <- list(...)
-    nms <- names(dots)[!sapply(dots, is.null)]
+    nms <- names(dots)[!vapply(dots, is.null, logical(1))]
     if (length(nms)) {
       inform(paste0(
         "The following specified arguments were ignored by 'pairs_condition' ",

R/ppc-censoring.R

@@ -167,8 +167,8 @@ ppc_km_overlay <- function(
   fsf <- fortify(sf)
   if(any(grepl("add_group", levels(fsf$strata)))){
     strata_split <- strsplit(as.character(fsf$strata), split = ", add_group:")
-    fsf$strata <- as.factor(sapply(strata_split, "[[", 1))
-    fsf$group <- as.factor(sapply(strata_split, "[[", 2))
+    fsf$strata <- as.factor(vapply(strata_split, "[[", character(1), 1))
+    fsf$group <- as.factor(vapply(strata_split, "[[", character(1), 2))
   }
 
   fsf$is_y_color <- as.factor(sub("\\[rep\\] \\(.*$", "rep", sub("^italic\\(y\\)", "y", fsf$strata)))