tests/testthat/test_mcmc_tools.R

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

context("Test mcmc.list tools")

test_that('get_inds extracts indices',{
  params_raw <- c('beta[1]','beta[2]')  
  expect_equal(get_inds('beta',params_raw),matrix(c(1,2)))
  params_raw <- c('gamma[1,1]','gamma[2,1]','gamma[1,3]')
  expect_equal(get_inds('gamma',params_raw),
               matrix(c(1,1,2,1,1,3),ncol=2,byrow=T))
  params_raw <- c('kappa[1,1,1]','kappa[2,1,1]','kappa[1,3,1]')
  expect_equal(get_inds('kappa',params_raw),
               matrix(c(1,1,1,2,1,1,1,3,1),ncol=3,byrow=T))
  params_raw <- 'alpha'
  inds <- expect_warning(get_inds('alpha',params_raw)[1,1])
  expect_true(is.na(inds))
})

test_that('strip_params removes brackets and indices',{
  params_raw <- c('alpha','beta[1]','beta[2]','gamma[1,2]','kappa[1,2,3]')
  expect_equal(strip_params(params_raw),
               c('alpha','beta','beta','gamma','kappa'))
  expect_equal(strip_params(params_raw,unique=T),
               c('alpha','beta','gamma','kappa'))
})

test_that('which_params gets param col indices',{
  params_raw <- c('alpha','beta[1]','beta[2]','gamma[1,1]','gamma[3,1]')
  expect_equal(which_params('alpha',params_raw),1)
  expect_equal(which_params('beta',params_raw),c(2,3))
  expect_equal(which_params('gamma',params_raw),c(4,5))
  expect_null(which_params('kappa',params_raw))
})

test_that('param_names returns correct names',{
  samples <- readRDS('coda_samples.rds')
  expect_equal(param_names(samples),
    c("alpha", "beta", "sigma", "mu[1]", "mu[2]", "mu[3]", "mu[4]",
    "mu[5]", "mu[6]", "mu[7]", "mu[8]", "mu[9]", "mu[10]", "mu[11]",
    "mu[12]", "mu[13]", "mu[14]", "mu[15]", "mu[16]", "kappa[1,1,1]",
    "kappa[2,1,1]", "kappa[1,2,1]", "kappa[2,2,1]", "kappa[1,1,2]",
    "kappa[2,1,2]", "kappa[1,2,2]", "kappa[2,2,2]", "deviance"))
  expect_equal(param_names(samples,simplify=T),
               c('alpha','beta','sigma','mu','kappa','deviance'))
})

test_that('select_cols works correctly',{
  samples <- readRDS('coda_samples.rds')
  expect_equal(dim(samples[[1]]),c(30,28))
  out <- select_cols(samples,1:3)
  expect_equal(class(out),'mcmc.list')
  expect_equal(length(out),length(samples))
  expect_equal(unlist(lapply(out,nrow)),unlist(lapply(samples,nrow)))
  expect_equal(colnames(out[[1]]),c('alpha','beta','sigma'))
  expect_equal(lapply(out,dim),list(c(30,3),c(30,3),c(30,3)))
  expect_equal(unlist(lapply(out,class)),rep('mcmc',3))
  expect_equal(attr(out[[1]],'mcpar'),c(1042,1100,2))
  out <- select_cols(samples,-c(1:3))
  expect_equal(dim(out[[1]]),c(30,25))
  expect_equal(colnames(out[[1]])[1],'mu[1]')
  out <- select_cols(samples,1)
  expect_equal(colnames(out[[1]]),'alpha')
  expect_equal(dim(out[[1]]),c(30,1))
})

test_that('remove_params drops correct params',{
  samples <- readRDS('coda_samples.rds')
  rc <- remove_params(samples,params=NULL)
  expect_equal(param_names(rc,simplify=T),
               c('alpha','beta','sigma','mu','kappa','deviance'))
  rc <- remove_params(samples,c('alpha','mu'))
  expect_equal(param_names(rc,simplify=T),
               c('beta','sigma','kappa','deviance'))
  expect_equal(dim(rc[[1]]),c(30,11))
  expect_equal(length(rc),3)
  rc <- remove_params(samples,c('beta','mu','sigma','kappa','deviance'))
  expect_equal(colnames(rc[[1]]),'alpha')
  expect_equal(dim(rc[[1]]),c(30,1))
  rc <- remove_params(samples, c('alpha','fake'))
  expect_equal(dim(rc[[1]]),c(30,27))
  rc <- remove_params(samples, c('fake'))
  expect_equal(dim(rc[[1]]),c(30,28))
})

test_that('mcmc_to_mat converts properly',{
  samples <- readRDS('coda_samples.rds')
  mat <- mcmc_to_mat(samples)
  expect_equal(class(mat),'matrix')
  expect_equal(dim(mat),c(90,28))
  expect_equal(mat[c(100,200,300)],
               c(0.03706,0.58666,59.99273),tolerance=1e-4)
  #samp1 <- samples[,1]
  samp1 <- select_cols(samples,1)
  mat2 <- mcmc_to_mat(samp1)
  expect_equal(class(mat2),'matrix')
  expect_equal(dim(mat2),c(90,1))
  samp1 <- lapply(samp1, as.vector)
  mat3 <- mcmc_to_mat(samp1)
  expect_equal(class(mat3),'matrix')
  expect_equal(dim(mat3),c(90,1))
})

test_that('comb_mcmc_list combines correctly',{
  comb_samples1 <- readRDS('comb_samples1.rds')
  comb_samples2 <- readRDS('comb_samples2.rds')
  comb_object <- comb_mcmc_list(comb_samples1,comb_samples2)
  expect_equal(nrow(comb_object[[1]]),20)
  expect_equal(length(comb_object),3)
})

test_that('check_parameter works correctly',{
  samples <- readRDS('coda_samples.rds')
  expect_error(check_parameter('alpha',samples),NA)
  expect_error(check_parameter('fake',samples))
})