diff --git a/R/sparse.R b/R/sparse.R index f16aa99..4caba8a 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -12,6 +12,7 @@ sample_sparse_tmb <- function(obj, iter, warmup, cores, chains, control=NULL, seed=NULL){ iter <- iter-warmup + obj$env$beSilent() sdr <- sdreport(obj, getJointPrecision=TRUE) Q <- sdr$jointPrecision Qinv <- solve(Q) @@ -95,7 +96,7 @@ as.tmbfit <- function(x, mle, invf){ mon$Rhat <- mon$rhat ## prepare objects to use the pairs_admb function post <- get_post(x, invf, parnames=parnames, TRUE) - sp <- x@diagnostics + sp <- as.data.frame(x@diagnostics) spl <- list() for(chain in 1:max(sp$.chain)){ spl[[chain]] <- as.matrix(sp[sp$.chain==chain,1:6]) @@ -104,7 +105,7 @@ as.tmbfit <- function(x, mle, invf){ monitor=mon, model='test', max_treedepth=x@metadata$max_depth, warmup=as.numeric(x@metadata$num_warmup), - iter=as.numeric(x@metadata$num_samples), + ## iter=as.numeric(x@metadata$num_samples)+as.numeric(x@metadata$num_warmup), algorithm='NUTS') adfit(x) } diff --git a/R/utils.R b/R/utils.R index 50a57ef..7280b94 100644 --- a/R/utils.R +++ b/R/utils.R @@ -513,7 +513,7 @@ check_identifiable <- function(model, path=getwd()){ ## matrix operations. x.cur <- (1/chd) * y.cur } else if(is(M,"Matrix")){ - warning( "Use of Q is highly experimental still" ) + ## warning( "Use of Q is highly experimental still" ) stopifnot(require(Matrix)) # M is actually Q, i.e., the inverse-mass # Antidiagonal matrix JJ = I @@ -756,8 +756,12 @@ extract_sampler_params <- function(fit, inc_warmup=FALSE){ ind <- -(1:fit$warmup) its <- (1:nrow(x[[1]]))[ind] } - y <- do.call(rbind, lapply(1:length(x), function(i) - cbind(chain=i, iteration=its, x[[i]][ind,]))) + y <- do.call(rbind, lapply(1:length(x), function(i){ + if(length(its) != NROW(x[[i]][ind,])) + warning("Length mismatch in extract_sampler_params: iterations=", length(its), + " and draws=", NROW(x[[i]][ind,])) + cbind(chain=i, iteration=its, x[[i]][ind,]) + })) return(invisible(as.data.frame(y))) }