tests/testthat/test-example_transfusion.R

In multinma: Bayesian Network Meta-Analysis of Individual and Aggregate Data

# Generated by vignette example_transfusion.Rmd: do not edit by hand
# Instead edit example_transfusion.Rmd and then run precompile.R

skip_on_cran()



params <-
list(run_tests = FALSE)

## ----code=readLines("children/knitr_setup.R"), include=FALSE--------------------------------------

## ----include=FALSE--------------------------------------------------------------------------------
set.seed(2684319)


## ----eval = FALSE---------------------------------------------------------------------------------
## library(multinma)
## options(mc.cores = parallel::detectCores())

## ----setup, echo = FALSE--------------------------------------------------------------------------
library(multinma)
nc <- switch(tolower(Sys.getenv("_R_CHECK_LIMIT_CORES_")), 
             "true" =, "warn" = 2, 
             parallel::detectCores())
options(mc.cores = nc)


## -------------------------------------------------------------------------------------------------
head(transfusion)


## -------------------------------------------------------------------------------------------------
tr_net <- set_agd_arm(transfusion, 
                           study = studyc,
                           trt = trtc,
                           r = r, 
                           n = n,
                           trt_ref = "Control")
tr_net


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))
summary(half_normal(scale = 5))


## ----eval=FALSE, echo=TRUE------------------------------------------------------------------------
## tr_fit_RE_noninf <- nma(tr_net,
##                         trt_effects = "random",
##                         prior_intercept = normal(scale = 100),
##                         prior_trt = normal(scale = 100),
##                         prior_het = half_normal(scale = 5))

## ----echo=FALSE, eval=!params$run_tests-----------------------------------------------------------
## tr_fit_RE_noninf <- nma(tr_net,
##                         seed = 857369814,
##                         trt_effects = "random",
##                         prior_intercept = normal(scale = 100),
##                         prior_trt = normal(scale = 100),
##                         prior_het = half_normal(scale = 5))

## ----echo=FALSE, eval=params$run_tests------------------------------------------------------------
tr_fit_RE_noninf <- suppressWarnings(nma(tr_net, 
                        seed = 857369814,
                        trt_effects = "random",
                        prior_intercept = normal(scale = 100),
                        prior_trt = normal(scale = 100),
                        prior_het = half_normal(scale = 5),
                        iter = 10000,
                        save_warmup = FALSE))


## -------------------------------------------------------------------------------------------------
tr_fit_RE_noninf


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(tr_fit_RE_noninf, pars = c("d", "mu", "delta"))


## ----tr_RE_noninf_pp_plot-------------------------------------------------------------------------
plot_prior_posterior(tr_fit_RE_noninf, prior = "het")


## -------------------------------------------------------------------------------------------------
noninf_tau <- as.array(tr_fit_RE_noninf, pars = "tau")
noninf_tausq <- noninf_tau^2
names(noninf_tausq) <- "tausq"
summary(noninf_tausq)


## -------------------------------------------------------------------------------------------------
summary(log_normal(-3.93, 1.51))


## ----echo=TRUE, eval=FALSE------------------------------------------------------------------------
## tr_fit_RE_inf <- nma(tr_net,
##                      trt_effects = "random",
##                      prior_intercept = normal(scale = 100),
##                      prior_trt = normal(scale = 100),
##                      prior_het = log_normal(-3.93, 1.51),
##                      prior_het_type = "var")

## ----echo=FALSE, eval=!params$run_tests-----------------------------------------------------------
## tr_fit_RE_inf <- nma(tr_net,
##                      seed = 1803772660,
##                      trt_effects = "random",
##                      prior_intercept = normal(scale = 100),
##                      prior_trt = normal(scale = 100),
##                      prior_het = log_normal(-3.93, 1.51),
##                      prior_het_type = "var")

## ----echo=FALSE, eval=params$run_tests------------------------------------------------------------
tr_fit_RE_inf <- suppressWarnings(nma(tr_net, 
                     seed = 1803772660,
                     trt_effects = "random",
                     prior_intercept = normal(scale = 100),
                     prior_trt = normal(scale = 100),
                     prior_het = log_normal(-3.93, 1.51),
                     prior_het_type = "var",
                     iter = 10000, save_warmup = FALSE))


## -------------------------------------------------------------------------------------------------
tr_fit_RE_inf


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(tr_fit_RE_inf, pars = c("d", "mu", "delta"))


## ----tr_RE_inf_pp_plot----------------------------------------------------------------------------
plot_prior_posterior(tr_fit_RE_inf, prior = "het")


## -------------------------------------------------------------------------------------------------
inf_tau <- as.array(tr_fit_RE_inf, pars = "tau")
inf_tausq <- inf_tau^2
names(inf_tausq) <- "tausq"
summary(inf_tausq)


## ----transfusion_tests, include=FALSE, eval=params$run_tests--------------------------------------
#--- Test against TSD 2 results ---
library(testthat)

tol <- 0.05

# Non-informative prior
tr_RE_noninf_var <- as.data.frame(summary(noninf_tausq))

test_that("Non-informative RE heterogeneity variance", {
  skip("Non-informative priors not identical")
  expect_equivalent(tr_RE_noninf_var$`50%`, 2.74, tolerance = tol)
  expect_equivalent(tr_RE_noninf_var$`2.5%`, 0.34, tolerance = tol)
  expect_equivalent(tr_RE_noninf_var$`97.5%`, 18.1, tolerance = tol)
})

# Informative prior
tr_RE_inf_var <- as.data.frame(summary(inf_tausq))

test_that("Informative RE heterogeneity variance", {
  expect_equivalent(tr_RE_inf_var$`50%`, 0.18, tolerance = tol)
  expect_equivalent(tr_RE_inf_var$`2.5%`, 0.003, tolerance = tol)
  skip_on_ci()
  expect_equivalent(tr_RE_inf_var$`97.5%`, 1.84, tolerance = tol)
})


# Force clean up
rm(list = ls())
gc()