tests/testthat/test_output_processing.R

In kenkellner/jagsUI2: A Wrapper Around 'rjags' to Streamline 'JAGS' Analyses

context("Test output processing")

test_that('fill_array works properly',{
  dat <- 1:10
  indices <- matrix(c(rep(1:5,2),rep(1:2,each=5)),ncol=2)
  out_mat <- matrix(dat,ncol=2)
  expect_equal(fill_array(dat,indices),out_mat)
  dat <- 1:20
  indices <- matrix(c(rep(1:5,4),
                      rep(rep(1:2,each=5),2),
                      rep(1:2,each=10)),ncol=3)
  out_arr <- array(dat,dim=c(5,2,2))
  expect_equal(fill_array(dat,indices),out_arr)
})

test_that('get_posterior_array output structure is correct',{
  samples <- readRDS('coda_samples.rds')
  n_chains <- length(samples)
  n_samples <- nrow(samples[[1]])
  out <- get_posterior_array('alpha',samples)
  expect_equal(class(out),'numeric')
  expect_equal(length(out),n_samples*n_chains)
  out <- get_posterior_array('mu',samples)
  expect_equal(class(out),'matrix')
  expect_equal(dim(out),c(n_samples*n_chains,16))
  out <- get_posterior_array('kappa',samples)
  expect_equal(class(out),'array')
  expect_equal(dim(out),c(n_samples*n_chains,2,2,2))
})

test_that('sims_list generates correct sims.list',{
  samples <- readRDS('coda_samples.rds')
  out <- sims_list(samples)
  expect_equal(class(out),'list')
  expect_equal(names(out),param_names(samples,T))
  expect_equal(sapply(out,class), c(alpha = "numeric", beta = "numeric", 
                                   sigma = "numeric", mu = "matrix",
                                   kappa = "array", deviance = "numeric"))
  expect_equal(sapply(out,dim), list(alpha = NULL, beta = NULL, sigma = NULL, 
                                    mu = c(90L, 16L), 
                                    kappa = c(90L, 2L, 2L, 2L), 
                                    deviance = NULL))
})

test_that('get_stat_array generates correcty array',{
  samples <- readRDS('coda_samples.rds')
  sum <- calc_stats(samples)
  mean_alpha <- get_stat_array('alpha','mean',sum)
  expect_equal(mean_alpha, 51.90933, tol=1e-4)
  f_mu <- get_stat_array('mu','f',sum)
  expect_equal(f_mu, structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
                                          1, 1, 1, 1, 1), .Dim = 16L))
  sd_kappa <- get_stat_array('kappa', 'sd', sum)
  expect_equal(sd_kappa, structure(c(3.24041434459656, 2.99177153512039, 
                                     3.2912326732425, 3.35708890821258, 
                                     3.01174961734256, 3.34886787628231, 
                                     2.97520825307743, 3.16364214294695), 
                                   .Dim = c(2L, 2L, 2L)))
})

test_that('all_stat_arrays makes a list of stat arrays for all params', {
  samples <- readRDS('coda_samples.rds')
  sum <- calc_stats(samples)
  sal <- all_stat_arrays(sum)
  expect_is(sal, 'list')
  expect_equal(names(sal),c("mean", "sd", "2.5%", "25%", "50%", "75%", "97.5%", 
                            "Overlap0","f", "nEff", "Rhat"))
  expect_true(all(sapply(sal,class)=='list'))
  expect_equal(sal$mean$alpha, 51.90933, tol=1e-4)
  expect_equal(dim(sal$sd$kappa), c(2,2,2))
})

test_that('check_stat throws errors correctly',{
  mod_summary <- readRDS('example_summary.rds')
  expect_error(check_stat('fake',mod_summary),'Invalid stat "fake"')
  expect_error(check_stat('mean',mod_summary),NA)
})

test_that('process_output generates correct list of output',{
  samples <- readRDS('coda_samples.rds')
  out <- process_output(samples)
  expect_is(out,'list')
  expect_equal(length(out),15)
  expect_equal(names(out),c("sims.list", "mean", "sd", "q2.5", "q25", "q50", 
                            "q75", "q97.5","Overlap0", "f", "nEff", "Rhat", 
                            "pD", "DIC", "summary"))
  expect_is(out$sims.list,'list')
  expect_equal(out$sims.list, sims_list(samples))
  expect_equal(length(out$sims.list),length(param_names(samples,simplify=T)))
  expect_equal(out$summary,calc_stats(samples))
})