tests/testthat/test_bma.R

In danheck/metaBMA: Bayesian Model Averaging for Random and Fixed Effects Meta-Analysis

library(rstan)
library(testthat)
library(metaBMA)

set.seed(12352)
SE <- runif(20, .2, .8)
dat <- data.frame(yyy = rnorm(20, rnorm(20, .2, .3), SE), SE = SE, study = 1:20)
dat$xx <- rnorm(20, 0, 1)
dat$cat <- rep(c("a", "b"), 10)


test_that("bma works for fitted meta_* objects", {
  set.seed(12352)
  f1a <- meta_fixed(yyy, SE, study, data = dat, chains = 1, rel.tol = .1)
  f1b <- meta_fixed(yyy ~ 1, SE, study,
    data = dat,
    iter = 2000, logml = "stan", summarize = "stan", rel.tol = .1
  )
  expect_silent(bb <- bma(list("a" = f1a, "b" = f1b)))
  postprob <- unname(bb$posterior_models[c(2, 4)])
  expect_equal(postprob / sum(postprob), c(.5, .5), tolerance = .001)
  expect_equal(f1a$estimates[, 1:7], f1b$estimates[, 1:7], tolerance = .02)

  expect_is(f1a$logml, "numeric")
  expect_is(f1a$BF, "matrix")
  expect_is(f1a$estimates, "matrix")

  skip_on_cran()

  suppressWarnings(r1b <- meta_random(yyy ~ 1, SE, study,
    data = dat,
    logml = "stan", logml_iter = 1500, iter = 100
  ))
  expect_is(r1b$logml, "numeric")
  expect_is(r1b$BF, "matrix")
  expect_is(r1b$estimates, "matrix")

  expect_silent(bb <- bma(list("a" = f1a, "b" = f1b, "d" = r1b),
    rel.tol = .01
  ))
  mean_avg <- sum(bb$posterior_models * bb$estimates[-1, "mean"])
  expect_equal(mean_avg, bb$estimates["averaged", "mean"], tolerance = .01)

  expect_is(bb$logml, "numeric")
  expect_is(bb$BF, "matrix")
  expect_is(bb$estimates, "matrix")


  suppressWarnings(r1a <- meta_random(yyy, SE, study,
    data = dat,
    summarize = "int",
    rel.tol = .01, iter = 100
  ))
  expect_silent(bb <- bma(list("a" = r1a, "b" = r1b), rel.tol = .Machine$double.eps^.1))
  postprob <- unname(bb$posterior_models[c(2, 4)])
  expect_equal(postprob / sum(postprob), c(.5, .5), tolerance = .01)
  expect_equal(r1a$estimates[, 1:7], r1b$estimates[, 1:7], tolerance = .05)
})


test_that("meta_bma gives identical results for stan/integrate", {

  skip_on_cran()

  set.seed(12352)
  mf_stan <- meta_bma(yyy, SE, study, dat,
    summarize = "stan", logml = "stan",
    logml_iter = 5000, iter = 10000
  )
  suppressWarnings({
    mf_int <- meta_bma(yyy, SE, study, dat,
      summarize = "int",
      logml = "int", iter = 100,
      rel.tol = .05
    )
  })
  expect_equal(mf_stan$estimates[, 1:7], mf_int$estimates[, 1:7], tolerance = .03)
  expect_equal(mf_stan$BF, mf_int$BF, tolerance = .01)
  expect_equal(mf_stan$inclusion, mf_int$inclusion, tolerance = .01)

  expect_silent(plot_forest(mf_stan))
  expect_silent(plot_forest(mf_int))
  expect_silent(plot_posterior(mf_int, from = 0, to = 1))
  expect_silent(plot_posterior(mf_stan))
})


test_that("inclusion() works correctly", {

  skip_on_cran()

  expect_silent(f1a <- meta_fixed(yyy, SE, study, data = dat, chains = 1, rel.tol = .01))
  expect_silent(f1b <- meta_fixed(yyy ~ 1, SE, study,
    data = dat, iter = 1750,
    logml = "stan", summarize = "stan", rel.tol = .01
  ))

  expect_silent(bb0 <- bma(list("a" = f1a, "b" = f1b), rel.tol = .01))
  expect_silent(bb1 <- inclusion(list("a" = f1a, "b" = f1b), include = c(2, 4)))
  expect_silent(bb2 <- inclusion(list("a" = f1a, "b" = f1b), include = "H1"))

  expect_is(bb1$prior, "numeric")
  expect_is(bb1$posterior, "numeric")
  expect_is(bb1$incl.prior, "numeric")
  expect_is(bb1$incl.posterior, "numeric")
  expect_is(bb1$incl.BF, "numeric")
  expect_is(bb1$include, "numeric")

  expect_equal(bb0$posterior_models, bb1$posterior)
  expect_equal(bb0$posterior_models, bb2$posterior)
  expect_equal(bb0$BF["a.fixed_H1", "a.fixed_H0"], bb2$incl.BF, tolerance = .001)
  expect_equal(bb1$incl.BF, bb2$incl.BF)
})