From 0dae798f344e6f97e9084cfc9929585806e22a18 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Wed, 24 Jan 2024 08:51:45 -0500 Subject: Fix more CRAN test problems --- DESCRIPTION | 4 +-- Makefile | 2 +- inst/tinytest/test_autojags.R | 28 ++++++++++++------- inst/tinytest/test_input_processing.R | 10 +++---- inst/tinytest/test_jags.R | 45 ++++++++++++++++++++---------- inst/tinytest/test_jagsbasic.R | 19 +++++++++---- inst/tinytest/test_mcmc_tools.R | 2 +- inst/tinytest/test_process_output.R | 52 ++++++++++++++++++++--------------- inst/tinytest/test_update.R | 33 +++++++++++++--------- tests/tinytest.R | 2 +- 10 files changed, 121 insertions(+), 76 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a7f43ca..5f138ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: jagsUI -Version: 1.6.1 -Date: 2024-01-23 +Version: 1.6.2 +Date: 2024-01-24 Title: A Wrapper Around 'rjags' to Streamline 'JAGS' Analyses Authors@R: c( person("Ken", "Kellner", email="contact@kenkellner.com", role=c("cre","aut")), diff --git a/Makefile b/Makefile index 6d49f26..5f9b685 100644 --- a/Makefile +++ b/Makefile @@ -17,7 +17,7 @@ cran-check: test: make install - Rscript -e "Sys.setenv("AT_HOME" = "TRUE"); tinytest::test_package('jagsUI')" + Rscript -e "Sys.setenv("AT_HOME" = "TRUE"); tinytest::test_package('jagsUI', color=FALSE, verbose=0)" coverage: make install diff --git a/inst/tinytest/test_autojags.R b/inst/tinytest/test_autojags.R index e06c75e..61ff997 100644 --- a/inst/tinytest/test_autojags.R +++ b/inst/tinytest/test_autojags.R @@ -1,3 +1,4 @@ +at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) set.seed(123) data(longley) @@ -25,11 +26,14 @@ 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)) -ref <- readRDS("autojags_ref.Rds") + # Remove time/date based elements -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +if(at_home){ + ref <- readRDS("autojags_ref.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +} # codaOnly--------------------------------------------------------------------- @@ -37,11 +41,13 @@ 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"))) -ref <- readRDS("autojags_ref_codaonly.Rds") # Remove time/date based elements -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +if(at_home){ + ref <- readRDS("autojags_ref_codaonly.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(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 @@ -69,12 +75,14 @@ expect_true(grepl("Update 3", nul[10])) expect_true(nul[11] == "") # All are combined to yield 30 total iterations in each chain expect_equal(coda::niter(out$samples), 30) -ref <- readRDS("autojags_ref_alliter.Rds") -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) + +if(at_home){ + ref <- readRDS("autojags_ref_alliter.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +} # Parallel---------------------------------------------------------- -at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) if(at_home){ set.seed(123) nul <- capture.output( diff --git a/inst/tinytest/test_input_processing.R b/inst/tinytest/test_input_processing.R index 18affd0..e6ffc27 100644 --- a/inst/tinytest/test_input_processing.R +++ b/inst/tinytest/test_input_processing.R @@ -15,7 +15,7 @@ data1 <- list(a=1, b=c(1,2), c=matrix(rnorm(4), 2,2), d=array(rnorm(8), c(2,2,2)), e=c(NA, 1)) test <- process_input(data1, params="a", NULL, 2, 1, 100, 50, 2, NULL, DIC=TRUE, quiet=TRUE, parallel=FALSE) -expect_identical(test$data, data1) +expect_equal(test$data, data1) # Data frame handling data2 <- list(a=data.frame(v1=c(1,2)), b=data.frame(v1=c(0,1), v2=c(2,3))) @@ -143,7 +143,7 @@ set.seed(123) test <- check_inits(inits1, n_chains=2) ref <- list(list(.RNG.name = "base::Mersenne-Twister", .RNG.seed = 28758), list(.RNG.name = "base::Mersenne-Twister", .RNG.seed = 78830)) -expect_identical(test, ref) +expect_equal(test, ref) # A list of lists set.seed(123) @@ -151,7 +151,7 @@ test <- check_inits(inits2, n_chains=2) ref <- list(list(a = 1, b = 2, .RNG.name = "base::Mersenne-Twister", .RNG.seed = 28758), list(a = 3, b = 4, .RNG.name = "base::Mersenne-Twister", .RNG.seed = 78830)) -expect_identical(test, ref) +expect_equal(test, ref) # Wrong number of list elements for number of chains expect_error(check_inits(inits2, n_chains=3)) @@ -164,14 +164,14 @@ test <- check_inits(inits4, n_chains=2) ref <- list(list(a = 1, b = 2, .RNG.name = "base::Mersenne-Twister", .RNG.seed = 28758), list(a = 1, b = 2, .RNG.name = "base::Mersenne-Twister", .RNG.seed = 78830)) -expect_identical(test, ref) +expect_equal(test, ref) # An empty list set.seed(123) test <- check_inits(inits5, n_chains=2) ref <- list(list(.RNG.name = "base::Mersenne-Twister", .RNG.seed = 28758), list(.RNG.name = "base::Mersenne-Twister", .RNG.seed = 78830)) -expect_identical(test, ref) +expect_equal(test, ref) # Function but doesn't return list expect_error(check_inits(inits6, n_chains=2)) diff --git a/inst/tinytest/test_jags.R b/inst/tinytest/test_jags.R index 6d57a6a..fab9e35 100644 --- a/inst/tinytest/test_jags.R +++ b/inst/tinytest/test_jags.R @@ -1,3 +1,4 @@ +at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) set.seed(123) data(longley) @@ -32,7 +33,10 @@ ref <- readRDS("longley_reference_fit.Rds") # Remove time/date based elements out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) + +if(at_home){ + expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +} # Plots pdf(NULL) @@ -69,13 +73,15 @@ 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, +if(at_home){ + 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, codaOnly=c("mu", "sigma"), verbose=FALSE) -ref <- readRDS("reference_codaOnly.Rds") + ref <- readRDS("reference_codaOnly.Rds") -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +} # DIC = FALSE------------------------------------------------------------------ out <- jags(data = data, inits = inits, parameters.to.save = params, @@ -83,32 +89,41 @@ out <- jags(data = data, inits = inits, parameters.to.save = params, n.burnin = 50, n.thin = 1, DIC=FALSE, verbose=FALSE) expect_false(out$calc.DIC) -ref <- readRDS("reference_noDIC.Rds") -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(15,16,19)], ref[-c(15,16,19)]) +if(at_home){ + ref <- readRDS("reference_noDIC.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(15,16,19)], ref[-c(15,16,19)]) +} # Reordered parameter names---------------------------------------------------- pars_new <- c("mu", "sigma", "alpha", "beta") out <- jags(data = data, inits = inits, parameters.to.save = pars_new, model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100, n.burnin = 50, n.thin = 1, verbose=FALSE) -ref <- readRDS("reference_parsorder.Rds") +expect_equal(c(paste0("mu[",1:16,"]"), "sigma","alpha","beta","deviance"), + colnames(out$samples[[1]])) -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +if(at_home){ + ref <- readRDS("reference_parsorder.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(17,18,21)], ref[-c(17,18,21)]) +} # Reordered parameter names and no DIC----------------------------------------- pars_new <- c("mu", "sigma", "alpha", "beta") out <- jags(data = data, inits = inits, parameters.to.save = pars_new, model.file = modfile, n.chains = 3, n.adapt = 100, n.iter = 100, n.burnin = 50, n.thin = 1, DIC = FALSE, verbose=FALSE) -ref <- readRDS("reference_parsorder_noDIC.Rds") +expect_equal(c(paste0("mu[",1:16,"]"), "sigma","alpha","beta"), + colnames(out$samples[[1]])) -out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out[-c(15,16,19)], ref[-c(15,16,19)]) +if(at_home){ + ref <- readRDS("reference_parsorder_noDIC.Rds") + out$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out[-c(15,16,19)], ref[-c(15,16,19)]) +} # Run in parallel-------------------------------------------------------------- -at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) if(parallel::detectCores() > 1 & at_home){ set.seed(123) params <- c('alpha','beta','sigma', 'mu') diff --git a/inst/tinytest/test_jagsbasic.R b/inst/tinytest/test_jagsbasic.R index d1c2f95..2ed54c9 100644 --- a/inst/tinytest/test_jagsbasic.R +++ b/inst/tinytest/test_jagsbasic.R @@ -1,3 +1,4 @@ +at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) set.seed(123) data(longley) @@ -25,9 +26,10 @@ 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) -ref <- readRDS("jagsbasic_reference_fit.Rds") - -expect_equal(out, ref) +if(at_home){ + ref <- readRDS("jagsbasic_reference_fit.Rds") + expect_equal(out, ref) +} # Saved model and reordered parameter names------------------------------------ set.seed(123) @@ -39,7 +41,10 @@ ref <- readRDS("jagsbasic_ref_saved.Rds") expect_equal(names(out), names(ref)) out$model <- ref$model -expect_equal(out, ref) + +if(at_home){ + expect_equal(out, ref) +} # Update----------------------------------------------------------------------- out2 <- update(out, n.iter=100, n.thin = 2, verbose=FALSE) @@ -47,7 +52,10 @@ expect_equal(nrow(out2$samples[[1]]), 50) ref <- readRDS('jagsbasic_ref_update.Rds') expect_equal(names(out2), names(ref)) out2$model <- ref$model -expect_equal(out2, ref) + +if(at_home){ + expect_equal(out2, ref) +} # Error if seed is set--------------------------------------------------------- expect_error(jags.basic(data = data, inits = inits, parameters.to.save = params, @@ -55,7 +63,6 @@ expect_error(jags.basic(data = data, inits = inits, parameters.to.save = params, n.burnin = 50, n.thin = 2, verbose=FALSE, save.model=TRUE, seed=123)) # Parallel--------------------------------------------------------------------- -at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) if(parallel::detectCores() > 1 & at_home){ set.seed(123) params <- c('beta', 'alpha', 'sigma', 'mu') diff --git a/inst/tinytest/test_mcmc_tools.R b/inst/tinytest/test_mcmc_tools.R index 73871f9..31db316 100644 --- a/inst/tinytest/test_mcmc_tools.R +++ b/inst/tinytest/test_mcmc_tools.R @@ -106,4 +106,4 @@ comb <- rbind( rbind(as.matrix(cs1[[2]]), as.matrix(cs2[[2]])), rbind(as.matrix(cs1[[3]]), as.matrix(cs2[[3]])) ) -expect_identical(comb, as.matrix(test)) +expect_equal(comb, as.matrix(test)) diff --git a/inst/tinytest/test_process_output.R b/inst/tinytest/test_process_output.R index edc4de5..e0a2729 100644 --- a/inst/tinytest/test_process_output.R +++ b/inst/tinytest/test_process_output.R @@ -1,3 +1,5 @@ +at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) + process_output <- jagsUI:::process_output calc_stats <- jagsUI:::calc_stats fill_array <- jagsUI:::fill_array @@ -44,14 +46,14 @@ expect_true(is.null(out2$pD)) #Exclude parameters out3 <- process_output(samples, coda_only=c("alpha","kappa", "mu"), DIC=TRUE, quiet=TRUE) -expect_identical(names(out3$sims.list), names(out$sims.list)) -expect_identical(names(out3$mean), names(out$mean)) +expect_equal(names(out3$sims.list), names(out$sims.list)) +expect_equal(names(out3$mean), names(out$mean)) expect_false(any(is.na(unlist(out3$mean)))) -expect_identical(rownames(out3$summary), c("beta", "sigma", "deviance")) +expect_equal(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. ")) +expect_equal(co, c("Calculating statistics....... ", "", "Done. ")) # Unexpected error happens during process_output------------------------------- @@ -61,12 +63,14 @@ expect_message(out_fail <- process_output(samples, quiet=TRUE)) expect_true(is.null(out_fail)) # result is NULL #test that process_output matches old jagsUI process.output-------------------- -old_all <- readRDS("old_jagsUI_output.Rds") -new_po <- process_output(old_all$samples, DIC=TRUE, quiet=TRUE) -old_po <- readRDS("old_process_output.Rds") -expect_identical(new_po$summary, old_all$summary) -new_po$summary <- NULL -expect_identical(new_po, old_po) +if(at_home){ + old_all <- readRDS("old_jagsUI_output.Rds") + new_po <- process_output(old_all$samples, DIC=TRUE, quiet=TRUE) + old_po <- readRDS("old_process_output.Rds") + expect_equal(new_po$summary, old_all$summary) + new_po$summary <- NULL + expect_equal(new_po, old_po) +} # test that fill_array works properly------------------------------------------ dat <- 1:10 @@ -229,22 +233,26 @@ expect_true(length(out) == 11) # test that stats for all parameters are calculated by calc_stats-------------- -samples <- readRDS('coda_samples.Rds') -st <- calc_stats(samples) -expect_equal(dim(st), c(length(param_names(samples)), 11)) -expect_equal(rownames(st), param_names(samples)) -expect_equal(colnames(st), c('mean','sd','q2.5','q25','q50','q75','q97.5', +if(at_home){ + samples <- readRDS('coda_samples.Rds') + st <- calc_stats(samples) + expect_equal(dim(st), c(length(param_names(samples)), 11)) + expect_equal(rownames(st), param_names(samples)) + expect_equal(colnames(st), c('mean','sd','q2.5','q25','q50','q75','q97.5', 'overlap0','f','Rhat','n.eff')) -ref_output <- readRDS('calc_stats_output.Rds') -expect_equal(st, ref_output) + ref_output <- readRDS('calc_stats_output.Rds') + expect_equal(st, ref_output) +} # test that calculating stats for a subset of parameters works----------------- -samples <- readRDS('coda_samples.Rds') -ref_output <- readRDS('calc_stats_output.Rds') -ref_output[c(1,4:19),2:11] <- NA -st_sub <- calc_stats(samples, coda_only=c('alpha','mu')) -expect_identical(ref_output, st_sub) +if(at_home){ + samples <- readRDS('coda_samples.Rds') + ref_output <- readRDS('calc_stats_output.Rds') + ref_output[c(1,4:19),2:11] <- NA + st_sub <- calc_stats(samples, coda_only=c('alpha','mu')) + expect_equal(ref_output, st_sub) +} # test that calculation of pD/DIC works---------------------------------------- diff --git a/inst/tinytest/test_update.R b/inst/tinytest/test_update.R index cb3613b..80485ea 100644 --- a/inst/tinytest/test_update.R +++ b/inst/tinytest/test_update.R @@ -1,3 +1,4 @@ +at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) set.seed(123) data(longley) @@ -32,33 +33,40 @@ expect_equal(out2$mcmc.info$n.samples, 150) expect_equal(nrow(out2$samples[[1]]), 50) # Remove time/date based elements -out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +if(at_home){ + out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +} # codaOnly--------------------------------------------------------------------- out2 <- update(out, n.iter=100, n.thin=2, verbose=FALSE, codaOnly='mu') -ref <- readRDS("update_ref_codaonly.Rds") -out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +if(at_home){ + ref <- readRDS("update_ref_codaonly.Rds") + out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +} # Different saved parameters--------------------------------------------------- out2 <- update(out, n.iter=100, n.thin=2, verbose=FALSE, parameters.to.save=c('beta', 'alpha')) -ref <- readRDS("update_ref_diffsaved.Rds") -out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +if(at_home){ + ref <- readRDS("update_ref_diffsaved.Rds") + out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(out2[-c(17,19,21)], ref[-c(17,19,21)]) +} # DIC = FALSE------------------------------------------------------------------ out2 <- update(out, n.iter=100, n.thin=2, verbose=FALSE, parameters.to.save=c('alpha'), DIC=FALSE) -ref <- readRDS("update_ref_noDIC.Rds") - expect_false(out2$calc.DIC) -out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins -expect_equal(out2[-c(15,17,19)], ref[-c(15,17,19)]) +if(at_home){ + ref <- readRDS("update_ref_noDIC.Rds") + out2$mcmc.info$elapsed.mins <- ref$mcmc.inf$elapsed.mins + expect_equal(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 @@ -69,7 +77,6 @@ expect_equal(coda::varnames(out2$samples), c("alpha","deviance")) expect_equal(names(out2), c("samples", "model")) # Parallel--------------------------------------------------------------------- -at_home <- identical( Sys.getenv("AT_HOME"), "TRUE" ) if(parallel::detectCores() > 1 & at_home){ set.seed(123) out <- jags(data = data, inits = inits, parameters.to.save = params, diff --git a/tests/tinytest.R b/tests/tinytest.R index 6c6da60..1fcd6d0 100644 --- a/tests/tinytest.R +++ b/tests/tinytest.R @@ -1,4 +1,4 @@ if ( requireNamespace("tinytest", quietly=TRUE) ){ - tinytest::test_package("jagsUI") + tinytest::test_package("jagsUI", color=FALSE, verbose=0) } -- cgit v1.2.3