Fix parallel bug and add parallel and stat calc tests

3 files changed, 52 insertions, 5 deletions

diff --git a/R/runparallel.R b/R/runparallel.R
index 6ee9985..b60b196 100644
--- a/R/runparallel.R
+++ b/R/runparallel.R
@@ -53,10 +53,11 @@ out <- samples <- model <- list()
 total.adapt <- sufficient.adapt <- vector(length=n.chains)
 
 #Save samples and model objects from each cluster
+total.adapt <- sapply(par, function(x) x[[3]])
+mc_start <- max(total.adapt) + n.burnin + n.thin
 for (i in 1:n.chains){
-  samples[[i]] <- coda::mcmc(par[[i]][[1]],start=n.burnin+n.thin,thin=n.thin)
+  samples[[i]] <- coda::mcmc(par[[i]][[1]],start=mc_start,thin=n.thin)
   model[[i]] <- par[[i]][[2]]
-  total.adapt[i] <- par[[i]][[3]]
   sufficient.adapt[i] <- par[[i]][[4]]
 }
 out$samples <- as.mcmc.list(samples)
diff --git a/inst/tinytest/test_jags.R b/inst/tinytest/test_jags.R
index 8295258..221de14 100644
--- a/inst/tinytest/test_jags.R
+++ b/inst/tinytest/test_jags.R
@@ -58,6 +58,16 @@ expect_equal(pp, 0)
 # Other methods
 expect_identical(out$summary, summary(out))
 
+# Double check stats calculations
+expect_equal(out$mean$alpha, mean(as.matrix(out$samples[,"alpha"])))
+expect_equal(out$sd$alpha, sd(as.matrix(out$samples[,"alpha"])))
+expect_equal(out$Rhat$alpha, coda::gelman.diag(out$samples[,"alpha"])$psrf[1])
+
+coda_sum <- summary(out$samples)
+expect_equal(out$summary[,"mean"], coda_sum$statistics[,"Mean"])
+expect_equal(out$summary[,"sd"], coda_sum$statistics[,"SD"])
+expect_equal(out$summary[,"50%"], coda_sum$quantiles[,"50%"])
+
 # codaOnly---------------------------------------------------------------------
 out <- jags(data = data, inits = inits, parameters.to.save = params,
             model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
@@ -97,6 +107,23 @@ ref <- readRDS("reference_parsorder_noDIC.Rds")
 out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins
 expect_identical(out[-c(15,16,19)], ref[-c(15,16,19)])
 
+# Run in parallel--------------------------------------------------------------
+if(parallel::detectCores() > 1){
+  set.seed(123)
+  params <- c('alpha','beta','sigma', 'mu')     
+  out <- jags(data = data, inits = inits, parameters.to.save = params,
+            model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 1000,
+            n.burnin = 500, n.thin = 2, verbose=FALSE, parallel=TRUE)
+  ref <- readRDS("longley_reference_fit.Rds")
+  expect_identical(out[-c(17,18,20:22)], ref[-c(17,18,20:22)])
+
+  # With n.adapt = NULL
+  out <- jags(data = data, inits = inits, parameters.to.save = params,
+            model.file = modfile, n.chains = 3, n.adapt = NULL, n.iter = 100,
+            n.burnin = 50, n.thin = 2, verbose=FALSE, parallel=TRUE)
+  expect_equal(out$mcmc.info$n.adapt, rep(100,3))
+}
+
 # Single parameter saved-------------------------------------------------------
 pars_new <- c("alpha")
 out <- jags(data = data, inits = inits, parameters.to.save = pars_new,
diff --git a/inst/tinytest/test_jagsbasic.R b/inst/tinytest/test_jagsbasic.R
index 927bd53..4e48ad4 100644
--- a/inst/tinytest/test_jagsbasic.R
+++ b/inst/tinytest/test_jagsbasic.R
@@ -29,7 +29,7 @@ ref <- readRDS("jagsbasic_reference_fit.Rds")
 
 expect_identical(out, ref)
 
-# Saved model and reordered parameter names
+# Saved model and reordered parameter names------------------------------------
 params <- c('beta', 'alpha', 'sigma', 'mu')     
 out <- jags.basic(data = data, inits = inits, parameters.to.save = params,
             model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
@@ -40,7 +40,7 @@ expect_identical(names(out), names(ref))
 out$model <- ref$model
 expect_identical(out, ref)
 
-# Update
+# Update-----------------------------------------------------------------------
 out2 <- update(out, n.iter=100, n.thin = 2, verbose=FALSE)
 expect_equal(nrow(out2$samples[[1]]), 50)
 
@@ -49,7 +49,26 @@ expect_identical(names(out2), names(ref))
 out2$model <- ref$model
 expect_equal(out2, ref)
 
-# Error if seed is set
+# Error if seed is set---------------------------------------------------------
 expect_error(jags.basic(data = data, inits = inits, parameters.to.save = params,
             model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
             n.burnin = 50, n.thin = 2, verbose=FALSE, save.model=TRUE, seed=123))
+
+# Parallel---------------------------------------------------------------------
+if(parallel::detectCores() > 1){
+  set.seed(123)
+  out <- jags.basic(data = data, inits = inits, parameters.to.save = params,
+              model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
+              n.burnin = 50, n.thin = 2, verbose=FALSE, parallel=TRUE)
+
+  ref <- readRDS("jagsbasic_reference_fit.Rds")
+  expect_identical(out[-c(17,18,20:22)], ref[-c(17,18,20:22)])
+}
+
+# Verbose---------------------------------------------------------------------
+co <- capture.output(jags.basic(data = data, inits = inits, parameters.to.save = params,
+            model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
+            n.burnin = 50, n.thin = 2, verbose=TRUE, save.model=TRUE)
+)
+test <- any(sapply(co, function(x) grepl("MCMC took", x)))
+expect_true(test)