use try() in is_chain_list() to avoid potential errors

if there's an error just return FALSE instead of erroring out

Author: jgabry

NEWS.md

@@ -7,7 +7,7 @@
 <!-- Items for next release go here* -->
 
 * MCMC plots now also accept objects with an `as.array` method as 
-  input. (#175, #184)
+  input (e.g., stanfit objects). (#175, #184)
 
 * [`mcmc_trace()`](https://mc-stan.org/bayesplot/reference/MCMC-traces.html)
   gains an argument `iter1` which can be used to label the traceplot starting

R/helpers-mcmc.R

@@ -15,16 +15,17 @@ prepare_mcmc_array <- function(x,
   } else if (is.data.frame(x)) {
     # data frame without Chain column
     x <- as.matrix(x)
-  } else if (!is.array(x)) {
+  } else {
     x <- as.array(x)
   }
 
   stopifnot(is.matrix(x) || is.array(x))
   if (is.array(x) && !(length(dim(x)) %in% c(2,3))) {
-    stop("Arrays should have 2 or 3 dimensions. See help('MCMC-overview').")
+    stop("Arrays should have 2 or 3 dimensions. See help('MCMC-overview').",
+         call. = FALSE)
   }
   if (anyNA(x)) {
-    stop("NAs not allowed in 'x'.")
+    stop("NAs not allowed in 'x'.", call. = FALSE)
   }
 
   parnames <- parameter_names(x)
@@ -172,7 +173,10 @@ df_with_chain2array <- function(x) {
 # @return TRUE or FALSE
 is_chain_list <- function(x) {
   check1 <- !is.data.frame(x) && is.list(x)
-  dims <- sapply(x, function(chain) length(dim(chain)))
+  dims <- try(sapply(x, function(chain) length(dim(chain))), silent=TRUE)
+  if (inherits(dims, "try-error")) {
+    return(FALSE)
+  }
   check2 <- isTRUE(all(dims == 2)) # all elements of list should be matrices/2-D arrays
   check1 && check2
 }
@@ -193,7 +197,8 @@ validate_chain_list <- function(x) {
     n_iter <- sapply(x, nrow)
     same_iters <- length(unique(n_iter)) == 1
     if (!same_iters) {
-      stop("Each chain should have the same number of iterations.")
+      stop("Each chain should have the same number of iterations.",
+           call. = FALSE)
     }
 
     cnames <- sapply(x, colnames)
@@ -204,7 +209,7 @@ validate_chain_list <- function(x) {
     }
     if (!same_params) {
       stop("The parameters for each chain should be in the same order ",
-           "and have the same names.")
+           "and have the same names.", call. = FALSE)
     }
   }
 
@@ -240,10 +245,10 @@ chain_list2array <- function(x) {
 parameter_names <- function(x) UseMethod("parameter_names")
 parameter_names.array <- function(x) {
   stopifnot(is_3d_array(x))
-  dimnames(x)[[3]] %||% stop("No parameter names found.")
+  dimnames(x)[[3]] %||% stop("No parameter names found.", call. = FALSE)
 }
 parameter_names.default <- function(x) {
-  colnames(x) %||% stop("No parameter names found.")
+  colnames(x) %||% stop("No parameter names found.", call. = FALSE)
 }
 
 # Check if an object is a 3-D array
@@ -292,17 +297,18 @@ validate_transformations <-
   function(transformations = list(),
            pars = character()) {
     if (is.null(names(transformations))) {
-      stop("'transformations' must be a _named_ list.")
+      stop("'transformations' must be a _named_ list.", call. = FALSE)
     } else if (any(!nzchar(names(transformations)))) {
-      stop("Each element of 'transformations' must have a name.")
+      stop("Each element of 'transformations' must have a name.", call. = FALSE)
     }
 
     transformations <- lapply(transformations, match.fun)
     if (!all(names(transformations) %in% pars)) {
       not_found <- which(!names(transformations) %in% pars)
       stop(
         "Some names(transformations) don't match parameter names: ",
-        paste(names(transformations)[not_found], collapse = ", ")
+        paste(names(transformations)[not_found], collapse = ", "),
+        call. = FALSE
       )
     }