@@ -15,16 +15,17 @@ prepare_mcmc_array <- function(x,
15
15
} else if (is.data.frame(x )) {
16
16
# data frame without Chain column
17
17
x <- as.matrix(x )
18
- } else if ( ! is.array( x )) {
18
+ } else {
19
19
x <- as.array(x )
20
20
}
21
21
22
22
stopifnot(is.matrix(x ) || is.array(x ))
23
23
if (is.array(x ) && ! (length(dim(x )) %in% c(2 ,3 ))) {
24
- stop(" Arrays should have 2 or 3 dimensions. See help('MCMC-overview')." )
24
+ stop(" Arrays should have 2 or 3 dimensions. See help('MCMC-overview')." ,
25
+ call. = FALSE )
25
26
}
26
27
if (anyNA(x )) {
27
- stop(" NAs not allowed in 'x'." )
28
+ stop(" NAs not allowed in 'x'." , call. = FALSE )
28
29
}
29
30
30
31
parnames <- parameter_names(x )
@@ -172,7 +173,10 @@ df_with_chain2array <- function(x) {
172
173
# @return TRUE or FALSE
173
174
is_chain_list <- function (x ) {
174
175
check1 <- ! is.data.frame(x ) && is.list(x )
175
- dims <- sapply(x , function (chain ) length(dim(chain )))
176
+ dims <- try(sapply(x , function (chain ) length(dim(chain ))), silent = TRUE )
177
+ if (inherits(dims , " try-error" )) {
178
+ return (FALSE )
179
+ }
176
180
check2 <- isTRUE(all(dims == 2 )) # all elements of list should be matrices/2-D arrays
177
181
check1 && check2
178
182
}
@@ -193,7 +197,8 @@ validate_chain_list <- function(x) {
193
197
n_iter <- sapply(x , nrow )
194
198
same_iters <- length(unique(n_iter )) == 1
195
199
if (! same_iters ) {
196
- stop(" Each chain should have the same number of iterations." )
200
+ stop(" Each chain should have the same number of iterations." ,
201
+ call. = FALSE )
197
202
}
198
203
199
204
cnames <- sapply(x , colnames )
@@ -204,7 +209,7 @@ validate_chain_list <- function(x) {
204
209
}
205
210
if (! same_params ) {
206
211
stop(" The parameters for each chain should be in the same order " ,
207
- " and have the same names." )
212
+ " and have the same names." , call. = FALSE )
208
213
}
209
214
}
210
215
@@ -240,10 +245,10 @@ chain_list2array <- function(x) {
240
245
parameter_names <- function (x ) UseMethod(" parameter_names" )
241
246
parameter_names.array <- function (x ) {
242
247
stopifnot(is_3d_array(x ))
243
- dimnames(x )[[3 ]] %|| % stop(" No parameter names found." )
248
+ dimnames(x )[[3 ]] %|| % stop(" No parameter names found." , call. = FALSE )
244
249
}
245
250
parameter_names.default <- function (x ) {
246
- colnames(x ) %|| % stop(" No parameter names found." )
251
+ colnames(x ) %|| % stop(" No parameter names found." , call. = FALSE )
247
252
}
248
253
249
254
# Check if an object is a 3-D array
@@ -292,17 +297,18 @@ validate_transformations <-
292
297
function (transformations = list (),
293
298
pars = character ()) {
294
299
if (is.null(names(transformations ))) {
295
- stop(" 'transformations' must be a _named_ list." )
300
+ stop(" 'transformations' must be a _named_ list." , call. = FALSE )
296
301
} else if (any(! nzchar(names(transformations )))) {
297
- stop(" Each element of 'transformations' must have a name." )
302
+ stop(" Each element of 'transformations' must have a name." , call. = FALSE )
298
303
}
299
304
300
305
transformations <- lapply(transformations , match.fun )
301
306
if (! all(names(transformations ) %in% pars )) {
302
307
not_found <- which(! names(transformations ) %in% pars )
303
308
stop(
304
309
" Some names(transformations) don't match parameter names: " ,
305
- paste(names(transformations )[not_found ], collapse = " , " )
310
+ paste(names(transformations )[not_found ], collapse = " , " ),
311
+ call. = FALSE
306
312
)
307
313
}
308
314
0 commit comments