From ff3d8b304e8d35597b815d9d973aea60987d0599 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Mon, 4 Dec 2023 20:34:33 -0500 Subject: Add test for graceful handling of process_output error, and Rhat --- R/process_output.R | 2 +- inst/tinytest/test_autojags.R | 11 +++++++++++ inst/tinytest/test_jags.R | 18 ++++++++++++++++++ inst/tinytest/test_process_output.R | 19 ++++++++++++++++--- inst/tinytest/test_update.R | 8 ++++++++ 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")) -- cgit v1.2.3