Add test for graceful handling of process_output error, and Rhatnew_process_output

5 files changed, 54 insertions, 4 deletions

diff --git a/R/process_output.R b/R/process_output.R
index 72bb669..a17ff48 100644
--- a/R/process_output.R
+++ b/R/process_output.R
@@ -1,11 +1,11 @@
 #------------------------------------------------------------------------------
 #Process output master function
 #To generate backwards-compatible jagsUI output
-#WIP
 process_output <- function(mcmc_list, coda_only=NULL, DIC, quiet=FALSE){
   if(!quiet){cat('Calculating statistics.......','\n')} 
 
   tryCatch({
+    if(DIC == -999) stop("Throwing error for testing purposes", call.=FALSE)
     # Get the sims.list
     sims <- list(sims.list = sims_list(mcmc_list))
     # Calculate all stats
diff --git a/inst/tinytest/test_autojags.R b/inst/tinytest/test_autojags.R
index 654c8ec..d8b6b84 100644
--- a/inst/tinytest/test_autojags.R
+++ b/inst/tinytest/test_autojags.R
@@ -42,3 +42,14 @@ ref <- readRDS("autojags_ref_codaonly.Rds")
 # Remove time/date based elements
 out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins
 expect_identical(out[-c(17,18,21)], ref[-c(17,18,21)])
+
+# Check recovery after process_output errors-----------------------------------
+# Setting DIC to -999 forces process_output to error for testing
+expect_message(nul<- capture.output(
+            out <- autojags(data = data, inits = inits, parameters.to.save = params,
+            model.file = modfile, n.chains = 3, n.adapt = 100, n.burnin=50, 
+            iter.increment=10, n.thin = 2, verbose=FALSE, codaOnly=c("mu"), DIC=-999)))
+expect_inherits(out, "jagsUIbasic")
+expect_equal(coda::varnames(out$samples), 
+             c("alpha","beta", "sigma", paste0("mu[",1:16,"]"),"deviance"))
+expect_equal(names(out), c("samples", "model"))
diff --git a/inst/tinytest/test_jags.R b/inst/tinytest/test_jags.R
index e30147c..9937f1e 100644
--- a/inst/tinytest/test_jags.R
+++ b/inst/tinytest/test_jags.R
@@ -123,6 +123,24 @@ out <- jags(data = dataList, parameters.to.save = c("v", "lambda"),
 expect_equal(rownames(out$summary), c("v", "lambda","deviance"))
 
 
+# No non-codaOnly parameters---------------------------------------------------
+
+out <- jags(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 = 1, verbose=FALSE, DIC=FALSE, 
+            codaOnly = params)
+expect_equal(nrow(out$summary), 0)
+
+# Check recovery after process_output errors-----------------------------------
+# Setting DIC to -999 forces process_output to error for testing
+expect_message(out <- jags(data = data, inits = inits, 
+                parameters.to.save = c("alpha","beta"),
+                model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100,
+                n.burnin = 50, n.thin = 1, verbose=FALSE, DIC=-999))
+expect_inherits(out, "jagsUIbasic")
+expect_equal(coda::varnames(out$samples), c("alpha","beta", "deviance"))
+expect_equal(names(out), c("samples", "model"))
+
 # Single chain and single iteration--------------------------------------------
 out <- jags(data = data, inits = inits, parameters.to.save = params,
             model.file = modfile, n.chains = 1, n.adapt = 100, n.iter = 100,
diff --git a/inst/tinytest/test_process_output.R b/inst/tinytest/test_process_output.R
index 2c56080..edc4de5 100644
--- a/inst/tinytest/test_process_output.R
+++ b/inst/tinytest/test_process_output.R
@@ -49,6 +49,11 @@ expect_identical(names(out3$mean), names(out$mean))
 expect_false(any(is.na(unlist(out3$mean))))
 expect_identical(rownames(out3$summary), c("beta", "sigma", "deviance"))
 
+# Check progress messages
+co <- capture.output(out <- process_output(samples, DIC=TRUE, quiet=FALSE))
+expect_identical(co, c("Calculating statistics....... ", "", "Done. "))
+                
+
 # Unexpected error happens during process_output-------------------------------
 
 # Here one of the arguments is missing
@@ -174,6 +179,16 @@ test[1,1] <- NA
 expect_equal(round(calc_f(test, mean(test,na.rm=T)),4), 0.3103)
 
 
+# Test that calculation of Rhat is correct-------------------------------------
+samples <- readRDS('coda_samples.Rds')
+alpha <- samples[,"alpha"]
+expect_equal(calc_Rhat(alpha), 1.003831, tol=1e-4)
+expect_error(calc_Rhat(samples))
+expect_equal(calc_Rhat(alpha[1]), NA)
+alpha[[1]][1] <- Inf
+expect_equal(calc_Rhat(alpha), NA)
+
+
 # test that all stats for one parameter calculated correctly-------------------
 samples <- readRDS('coda_samples.Rds')
 ps <- calc_param_stats(samples[,'alpha'], FALSE)
@@ -208,9 +223,7 @@ expect_equivalent(calc_param_stats(alpha_one, FALSE),
              c(51.870939,0.8998954,51.15826,51.36934,51.6038732,52.239005,
                52.8106251, 0, 1, NA, NA), tol=1e-4)
 #Test if error
-alpha_er <- samples[,"alpha"]
-alpha_er[[1]][1] <- 'a'
-expect_warning(out <- calc_param_stats(alpha_er, TRUE))
+expect_message(out <- calc_param_stats(alpha_one))
 expect_true(all(is.na(out)))
 expect_true(length(out) == 11)
 
diff --git a/inst/tinytest/test_update.R b/inst/tinytest/test_update.R
index d4c1da2..60b05c3 100644
--- a/inst/tinytest/test_update.R
+++ b/inst/tinytest/test_update.R
@@ -59,3 +59,11 @@ expect_false(out2$calc.DIC)
 
 out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins
 expect_identical(out2[-c(15,17,19)], ref[-c(15,17,19)])
+
+# Check recovery after process_output errors-----------------------------------
+# Setting DIC to -999 forces process_output to error for testing
+expect_message(out2 <- update(out, n.iter=100, n.thin=2, verbose=FALSE, 
+               parameters.to.save=c('alpha'), DIC=-999))
+expect_inherits(out2, "jagsUIbasic")
+expect_equal(coda::varnames(out2$samples), c("alpha","deviance"))
+expect_equal(names(out2), c("samples", "model"))