tests/testthat/test_sim.R

In mcmcsae: Markov Chain Monte Carlo Small Area Estimation

context("MCMC simulation")

set.seed(1, kind="Mersenne-Twister", normal.kind="Inversion")

ex <- mcmcsae_example()

test_that("MCMCsim arguments work", {
  expect_error(
    sampler <- create_sampler(
      y ~ reg(~x, name="beta") + gen(~x, factor = ~ iid(fA), name="v"),
      linpred = list(beta=matrix(0, 5, 2), v=Matrix(0, 4, 2*nlevels(ex$dat$fA))),
      data=ex$dat), "same number of rows"
  )
  sampler <- create_sampler(
    y ~ reg(~x, name="beta") + gen(~x, factor = ~ iid(fA), name="v"),
    linpred = list(beta=matrix(0, 5, 2), v=Matrix(0, 5, 2*nlevels(ex$dat$fA))),
    data=ex$dat
  )
  # or linear predictor composed of any subset of model components
  sampler <- create_sampler(
    y ~ reg(~x, name="beta") + gen(~x, factor = ~ iid(fA), name="v"),
    linpred = list(v=Diagonal(2*nlevels(ex$dat$fA))),
    data=ex$dat
  )
  sim <- MCMCsim(
    sampler,
    burnin=200, n.iter=500, n.chain=4, thin=2,
    pred = list(v_var="v_sigma^2"),
    trace.convergence=c("v_sigma", "beta", "v[1:3]"),
    verbose=FALSE
  )
  expect_is(sim$linpred_, "dc")
  expect_identical(dim(as.matrix(sim$linpred_)), c(1000L, 2L*nlevels(ex$dat$fA)))
  expect_equal(sim$linpred_, sim$v, check.attributes=FALSE)
  expect_is(sim$v_var, "dc")
  expect_length(sim$v_var, 4)
  expect_identical(dim(sim$v_var[[1]]), c(250L, 2L))
  expect_identical(dim(as.matrix(sim$v_var)), c(1000L, 2L))
})

test_that("combine_chains works", {
  sampler <- create_sampler(
    y ~ reg(~x, name="beta") + gen(~x, factor = ~ iid(fA), name="v"),
    linpred = list(beta=matrix(0, 5, 2), v=Matrix(0, 5, 2*nlevels(ex$dat$fA))),
    data=ex$dat
  )
  sim1 <- MCMCsim(sampler, burnin=10, n.iter=100, store.all=TRUE, verbose=FALSE)
  sim2 <- MCMCsim(sampler, burnin=10, n.iter=100, store.all=TRUE, verbose=FALSE)
  sim <- combine_chains(sim1, sim2)
  expect_identical(n_chains(sim), 6L)
  expect_identical(n_chains(combine_chains_dc(list(sim1$llh_, sim2$llh_))), 6L)
  pred1 <- predict(sim1, ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred2 <- predict(sim2, ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred <- combine_chains_dc(list(pred1, pred2))
  expect_identical(n_chains(pred), 6L)
  expect_length(attr(pred, "ppp"), 100L)
  expect_between(attr(pred, "ppp"), 0, 1)
  f <- function(x) c(mean(x), sd(x))
  pred1 <- predict(sim1, fun.=f, labels=c("mean", "sd"), ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred2 <- predict(sim2, fun.=f, labels=c("mean", "sd"), ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred <- combine_chains_dc(list(pred1, pred2))
  expect_identical(attr(pred, "labels"), c("mean", "sd"))
  f <- function(x) median(x)
  pred1 <- predict(sim1, fun.=f, labels="median", ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred2 <- predict(sim2, fun.=f, labels="median", ppcheck=TRUE, show.progress=FALSE, verbose=FALSE)
  pred <- combine_chains_dc(list(pred1, pred2))
  expect_identical(attr(pred, "labels"), "median")
  pred <- combine_iters_dc(list(pred1, pred2))
})

test_that("Parallel functionality works", {
  skip_if(parallel::detectCores() < 2L, "Skipping test: fewer than 2 cores available")
  sampler <- create_sampler(
    y ~ reg(~x, name="beta") + gen(~x, factor = ~ iid(fA), name="v"),
    linpred = list(beta=matrix(0, 5, 2), v=Matrix(0, 5, 2*nlevels(ex$dat$fA))),
    data=ex$dat
  )
  cl <- setup_cluster(n.cores=2)
  sim <- MCMCsim(sampler, burnin=10, n.iter=100, n.chain=4, store.all=TRUE, cl=cl, verbose=FALSE)
  expect_identical(sim[["_info"]]$n.chain, 4L)
  expect_length(sim[["beta"]], 4L)
  pred0 <- predict(sim, ppcheck=TRUE, n.cores=1L, show.progress=FALSE, verbose=FALSE)
  pred <- predict(sim, ppcheck=TRUE, cl=cl, show.progress=FALSE, verbose=FALSE)
  expect_length(pred, 4L)
  expect_length(attr(pred, "ppp"), 100L)
  expect_between(attr(pred, "ppp"), 0, 1)
  expect_between(mean(attr(pred, "ppp")), 0.8*mean(attr(pred0, "ppp")), 1.2*mean(attr(pred0, "ppp")))
  f <- function(x) sd(x)
  pred0 <- predict(sim, fun.=f, labels="median", ppcheck=TRUE, n.cores=1L, show.progress=FALSE, verbose=FALSE)
  pred <- predict(sim, fun.=f, labels="median", ppcheck=TRUE, cl=cl, show.progress=FALSE, verbose=FALSE)
  expect_length(attr(pred, "ppp"), 1L)
  expect_between(attr(pred, "ppp"), 0.8*attr(pred0, "ppp"), 1.2*attr(pred0, "ppp"))
  stop_cluster(sim[["_cluster"]])
})