tests/testthat/test_multcomp.R

In voi: Expected Value of Information

## Create a fake decision model output with three interventions 

pi2 <- "p_side_effects_t2"

set.seed(1)
nsim <- nrow(chemo_cea$e)
rr3_sim <- rgamma(nsim, 100, 100)
multcomp_cea <- chemo_cea
multcomp_cea$c <- as.data.frame(multcomp_cea$c)
multcomp_cea$e <- as.data.frame(multcomp_cea$e)
multcomp_cea$c$trt3 <- multcomp_cea$c$Novel * 1.2 * rr3_sim
multcomp_cea$e$trt3 <- multcomp_cea$e$Novel * 0.8 * rr3_sim      # new trt is worse 
multcomp_nb <- multcomp_cea$e*20000 - multcomp_cea$c
multcomp_pars <- cbind(chemo_pars, rr3_sim)

test_that("EVPPI for decision models with three decision options",{
  expect_equal(evpi(multcomp_nb), 417, tol=10)
  expect_equal(evppi(multcomp_nb, multcomp_pars, par=pi2)$evppi, 262, tol=1)
  expect_equal(evpi(multcomp_cea)$evpi[2], 417, tol=10)
  expect_equal(evppi(multcomp_cea, multcomp_pars, par=pi2)$evppi[2], 262, tol=1)
})


## Test the moment matching EVSI method
## Adapt the model function to three interventions

multcomp_model_cea <- function(p_side_effects_t1, p_side_effects_t2,
                                p_hospitalised_total, p_died,
                                lambda_home, lambda_hosp,
                                c_home_care, c_hospital, c_death,
                                u_recovery, u_home_care, u_hospital,
                                rate_longterm, rr3){
  ce <- chemo_model_cea(p_side_effects_t1 = p_side_effects_t1,
                        p_side_effects_t2 = p_side_effects_t2,
                        p_hospitalised_total = p_hospitalised_total,
                        p_died = p_died,
                        lambda_home = lambda_home,
                        lambda_hosp = lambda_hosp,
                        c_home_care = c_home_care,
                        c_hospital = c_hospital,
                        c_death = c_death,
                        u_recovery = u_recovery,
                        u_home_care = u_home_care,
                        u_hospital = u_hospital,
                        rate_longterm = rate_longterm)
  
  trt3 <- ce[,2] * rr3
  cbind(ce, trt3)
}

multcomp_pars_fn <- function(n){
  cbind(chemo_pars_fn(n), 
        rr3 = 1.2*rgamma(n, 100, 100))
}


test_that("moment matching method",{
  set.seed(100)
  expect_error(
    evsi(outputs=multcomp_nb, inputs=chemo_pars, 
              pars="p_side_effects_t1",
              method = "mm",  study =  "binary", n = c(100), Q = 5, 
              analysis_args = list(a=53, b=60, n=100),
              model_fn = chemo_model_nb,  par_fn = chemo_pars_fn),
    "Number of decision options")
  
  expect_error(
    evm <- evsi(outputs=chemo_cea, inputs=chemo_pars, 
              pars="p_side_effects_t1",
              method = "mm",
              study =  "binary",
              n = c(100), Q = 5, 
              analysis_args = list(a=53, b=60, n=100),
              model_fn = multcomp_model_cea,  par_fn = multcomp_pars_fn),
    "Number of decision options")

  set.seed(1)
  evm2 <- evsi(outputs=multcomp_cea, inputs=multcomp_pars, 
               pars="p_side_effects_t2",
               method = "mm", study =  "binary",
               n = c(100), Q = 5, 
               analysis_args = list(a=53, b=60, n=100),
               model_fn = multcomp_model_cea,  par_fn = multcomp_pars_fn)
  evm2
  expect_equal(evm2$evsi[2], 167, tol=1) 

  evm3 <- evsi(outputs=multcomp_cea, inputs=multcomp_pars, 
               pars="p_side_effects_t2",
               method = "gam", study =  "binary",
               analysis_args = list(a=53, b=60, n=100))
  expect_equal(evm3$evsi[2], 221, tol=1)
})


expect_not_equal <- function(x, y) expect_true(!isTRUE(identical(x, y)))

test_that("reference decision option",{
  expect_not_equal(
    evppi(multcomp_nb, multcomp_pars, pars=pi2, ref=3),
    evppi(multcomp_nb, multcomp_pars, pars=pi2, ref=1)
  )
  expect_not_equal(
    evppi(multcomp_nb, multcomp_pars, pars=pi2, ref="trt3"),
    evppi(multcomp_nb, multcomp_pars, pars=pi2, ref="SoC")
  )
})