tests/testthat/test_evppi.R

In voi: Expected Value of Information

## load_all(".")
#  load_all("voi")

pi1 <- "p_side_effects_t1"
pi2 <- "p_side_effects_t2"
rho <- "logor_side_effects"

test_that("single-parameter EVPPI",{
    evtest <- evppi(chemo_nb, chemo_pars, pars=pi2)
    expect_equal(evtest$evppi, 262.1109, tol=1e-05)
    evcea <- evppi(chemo_cea, chemo_pars, pars=pi2)
    expect_equal(evcea$evppi[evcea$k==20000], evtest$evppi, tol=1)
    expect_equal(evppi(chemo_nb, chemo_pars[,"p_side_effects_t2"])$evppi,
                 evtest$evppi)
    evcea <- evppi(chemo_cea, chemo_pars, pars=pi2, tidy=FALSE)
    expect_equal(evcea$evppi[evcea$k==20000], evtest$evppi, tol=1)
})

test_that("single-parameter EVPPI, alternative GAM basis",{
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, gam_formula="s(p_side_effects_t2, bs='tp')")$evppi,
                 261.8708, tol=1e-04)
})

test_that("single-parameter EVPPI, GP",{
    expect_equal(
        evppi(chemo_nb, chemo_pars, pars=pi2, method="gp", nsim=100)$evppi,
        285.4876, tol=1e-03)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, method="gp", nsim=100, gp_hyper_n=100)$evppi,
                 284.2202, tol=1e-03)
    gse <- evppi(chemo_nb, chemo_pars, pars=pi2, method="gp", nsim=100, se=TRUE, B=10)$se
    expect_true(is.numeric(gse))
})

test_that("single-parameter EVPPI, earth",{
    expect_equal(
        evppi(chemo_nb, chemo_pars, pars=pi2, method="earth")$evppi, 
        265.1299, tol=1e-03)
})

if (requireNamespace("INLA",quietly=TRUE)) { 
  test_that("EVPPI with INLA",{
    skip_on_cran()
    expect_error(evppi(chemo_nb, chemo_pars, pars=pi2, method="inla", nsim=100), "2 or more parameters")
    pars <- c(pi2,rho)
    set.seed(1)
    expect_equal(
      evppi(chemo_nb, chemo_pars, pars=pars, method="inla", nsim=1000)$evppi, 
      323.7706, tol=1e-02)
    expect_error({
      evppi(chemo_nb, chemo_pars, pars=pars, method="inla", nsim=1000, plot_inla_mesh = TRUE)
      evppi(chemo_nb, chemo_pars, pars=pars, method="inla", pfc_struc="iso", nsim=100)
      evppi(chemo_nb, chemo_pars, pars=pars, method="inla", pfc_struc="aniso", nsim=50)
    },NA)
  })
}

if (requireNamespace("dbarts",quietly=TRUE)) { 
  test_that("EVPPI with BART",{
    skip_on_cran()
    pars <- c(pi2,rho)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pars, method="bart", nsim=1000)$evppi,
                 324.2451, tol=1e-02)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pars, method="bart", nsim=1000, ndpost=2000, se=TRUE)$evppi,
                 324.0516, tol=1e-02)
  })
}

test_that("Standard errors in the earth method",{
  skip_on_cran()
  set.seed(1)
  ev1 <- evppi(chemo_nb, chemo_pars, pars=pi2, method="earth", se=TRUE, nsim=100)
  ev2 <- evppi(chemo_nb, chemo_pars, pars=pi2, method="earth", se=TRUE, nsim=500)
  expect_lt(ev2$se[1], ev1$se[1])
})

test_that("multi-parameter EVPPI, gam",{
    pars <- c(pi2,rho)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pars, method="gam")$evppi,
                 333.4516, tol=1e-01)
})

test_that("multi-parameter EVPPI, earth",{
    pars <- c(pi2,rho)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pars, method="earth")$evppi,
                 334.0442, tol=1e-02)
})

test_that("multi-parameter EVPPI, s() instead of t() formula",{
    pars <- c(pi2,rho)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pars, method="gam", 
                       gam_formula="s(p_side_effects_t2) + s(logor_side_effects)")$evppi,
                 333.8265, tol=1e-03)
})

test_that("Multiple EVPPI calculations with the same call",{
  evtest <- evppi(chemo_nb, chemo_pars, pars=list(pi1, pi2))
  evtest2 <- evppi(chemo_nb, chemo_pars, pars=pi2)
  expect_equal(evtest$evppi[evtest$pars==pi2], evtest2$evppi)
  evtest <- evppi(chemo_nb, chemo_pars, pars=list(c(pi1, pi2), rho))
  evtest2 <- evppi(chemo_nb, chemo_pars, pars=c(pi1,pi2))
  expect_equal(evtest$evppi[evtest$pars=="p_side_effects_t1,p_side_effects_t2"], 
               evtest2$evppi)
  ## CEA format and multi pars 
  evtest <- evppi(chemo_cea, chemo_pars, pars=list(pi1, pi2))
  evtest2 <- evppi(chemo_nb, chemo_pars, pars=list(pi1, pi2))
  expect_equal(evtest$evppi[evtest$pars==pi2 & evtest$k==20000], 
               evtest2$evppi[evtest2$pars==pi2], tol=1)
  evtest <- evppi(chemo_cea, chemo_pars, pars=list(c(pi1, pi2), rho))
  evcea <- evppi(chemo_cea, chemo_pars, pars=c(pi1, pi2))
  expect_equal(evtest$evppi[evtest$pars=="p_side_effects_t1,p_side_effects_t2" & 
                              evtest$k==20000], evcea$evppi[evcea$k==20000], tol=1e-05)
  
  e1 <- evppi(chemo_cea, chemo_pars, pars=list(pi1, pi2))
  e2 <- evppi(chemo_cea, chemo_pars, pars=list(pi2))
  expect_equal(
    e1$evppi[e1$pars=="p_side_effects_t2" & e1$k==40000],
    e2$evppi[e2$k==40000]
  )
})

test_that("Strong and Oakley single parameter", {
    expect_error(evppi(chemo_nb, chemo_pars, pars=pi2, method="so"),
                 "`n.blocks` is required")
    expect_error(evppi(chemo_nb, chemo_pars, pars=c(pi1,pi2), method="so", n.blocks=20),
                 "only works for single-parameter")
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, method="so", n.blocks=20)$evppi, 261.6701, tol=1e-02)
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, method="so", n.blocks=40)$evppi, 262.3276, tol=1e-02)
    expect_equal(evppi(chemo_cea, chemo_pars, pars=pi2, method="so", n.blocks=20)$evppi[3], 118.0415, tol=1e-02)
    expect_equal(evppi(chemo_cea, chemo_pars, pars=pi2, method="so", n.blocks=40)$evppi[3], 118.3353, tol=1e-02)
})

test_that("Sadatsafavi et al single parameter", {
    expect_error(evppi(chemo_nb, chemo_pars, pars=c(pi1,pi2), method="sal", n.blocks=20),
                 "only works for single-parameter")
    evtest <- evppi(chemo_nb, chemo_pars, pars=pi2, method="sal")
    expect_equal(evtest$evppi, 262.8047, tol=1e-01)
    expect_equal(evppi(chemo_cea, chemo_pars, pars=pi2, method="sal")$evppi[2], 
                 evtest$evppi)
})

test_that("Standard errors for GAM",{
    set.seed(1)
    evtest <- evppi(chemo_nb, chemo_pars, pars=pi2, se=TRUE, B=10)
    expect_equal(evtest$se[1],  2.509941, tol=1e-01)
    evtest <- evppi(chemo_nb, chemo_pars, pars=list(pi1, pi2), se=TRUE, B=10)
    expect_equal(evtest$se[2], 4.274408, tol=1e-01)
})

test_that("Spaces in variable names", {
    cp <- chemo_pars
    names(cp)[names(cp)==pi2] <- "pi 1"
    expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2)$evppi,
                 evppi(chemo_nb, cp, pars="pi 1")$evppi)
    
})

test_that("Variable names matching R built in objects", {
    cp <- chemo_pars
    names(cp)[names(cp)==pi2] <- "pi"
    expect_error(evppi(chemo_nb, cp, pars="pi"), "R internal constant")
    names(cp)[names(cp)=="pi"] <- "letters"
    expect_error(evppi(chemo_nb, cp, pars="letters"), "R internal constant")
})

test_that("reference decision option",{
  expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, ref=2),
               evppi(chemo_nb, chemo_pars, pars=pi2, ref=1)) # since only two options 
  expect_equal(evppi(chemo_nb, chemo_pars, pars=pi2, ref="Novel"),
               evppi(chemo_nb, chemo_pars, pars=pi2, ref="SoC")) # since only two options 
  
  expect_error(evppi(chemo_nb, chemo_pars, pars=pi2, ref="wrongname"),
               "does not appear")
  expect_error(evppi(chemo_nb, chemo_pars, pars=pi2, ref=3),
               "should either be a string")
})