diff --git a/tests/testthat/test-evppi.R b/tests/testthat/test-evppi.R index 17cb17a7..198dee7e 100644 --- a/tests/testthat/test-evppi.R +++ b/tests/testthat/test-evppi.R @@ -1,575 +1,575 @@ - -# mainly regression tests against old version of BCEA::evppi() -# from version <= 2.4.5 -# versus new evppi() calling voi::evppi internally - - -# library(BCEA) -if (interactive()) library(testthat) - -if (!requireNamespace("voi", quietly = TRUE)) { - stop( - "Package \"voi (>= 1.0.1)\" must be installed to use this function.", - call. = FALSE - ) -} - -test_that("GAM regression (default) with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # expect_length(inp, 2) - # expect_named(inp, c("mat", "parameters")) - # expect_type(inp, "list") - - # EVPPI <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat) - # save(EVPPI, file = "tests/testthat/testdata/EVPPI_GAM_default.RData") - load(file = test_path("testdata", "EVPPI_GAM_default.RData")) - - EVPPI_voi <- evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat) - - EVPPI_voi_orig <- voi::evppi(bcea_vacc[c("e","c","k")], - inputs = inp$mat, - pars = c("beta.1.", "beta.2."), - check = TRUE) - - expect_s3_class(EVPPI, "evppi") - expect_length(EVPPI, 10) - expect_type(EVPPI, "list") - - expect_s3_class(EVPPI_voi, "evppi") - expect_type(EVPPI_voi, "list") - - expect_equivalent(EVPPI$evppi, EVPPI_voi$evppi, tolerance = 0.001) - expect_equivalent(EVPPI_voi_orig$evppi, EVPPI_voi$evppi, tolerance = 0.001) - - expect_equivalent(EVPPI$k, EVPPI_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI_voi_orig$k, EVPPI_voi$k, tolerance = 0.001) - - expect_equivalent(EVPPI$evi, EVPPI_voi$evi, tolerance = 0.001) - expect_equivalent(EVPPI$index, EVPPI_voi$index) - expect_equivalent(EVPPI$fitted.costs, EVPPI_voi$fitted.costs, tolerance = 0.001) - expect_equivalent(EVPPI$fitted.effects, EVPPI_voi$fitted.effects, tolerance = 0.001) - expect_equivalent(EVPPI$select, EVPPI_voi$select) - - ##TODO: snapshot - # plot(EVPPI) - # plot(EVPPI_voi) - - rm(EVPPI) -}) - -test_that("Strong & Oakley with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - expect_error(evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "so", n.blocks = 50), - regexp = "only works for single-parameter EVPPI") - - # EVPPI.so <- BCEA::evppi(bcea_vacc, "beta.1.", inp$mat, method = "so", n.blocks = 50) - # save(EVPPI.so, file = "tests/testthat/testdata/EVPPI_so_default.RData") - load(file = test_path("testdata", "EVPPI_so_default.RData")) - - EVPPI.so_voi <- evppi(bcea_vacc, "beta.1.", inp$mat, method = "so", n.blocks = 50) - - expect_s3_class(EVPPI.so, "evppi") - expect_length(EVPPI.so, 6) - expect_type(EVPPI.so, "list") - - expect_s3_class(EVPPI.so_voi, "evppi") - expect_type(EVPPI.so_voi, "list") - - expect_equivalent(EVPPI.so$evppi, EVPPI.so_voi$evppi, tolerance = 0.001) - expect_equivalent(EVPPI.so$k, EVPPI.so_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI.so$evi, EVPPI.so_voi$evi, tolerance = 0.001) - expect_equivalent(EVPPI.so$index, EVPPI.so_voi$index) - - rm(EVPPI.so) -}) - -test_that("Sadatsafavi et al with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # voi::evppi only works for single-parameter EVPPI - - # EVPPI.sad <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "sad", n.seps = 1) - # save(EVPPI.sad, file = "tests/testthat/testdata/EVPPI_sad_default.RData") - # load(file = test_path("testdata", "EVPPI_sad_default.RData")) - - # TODO: error - # EVPPI.sal <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "sal", n.seps = 1) - - expect_error(evppi(bcea_vacc, param_idx = c("beta.1.", "beta.2."), inp$mat, method = "sal", n.seps = 1), - regexp = "only works for single-parameter EVPPI") - - # voiEVPPI.sad <- voi::evppi(outputs = bcea_vacc[c("e","c","k")], inputs = inp$mat, - # pars = c("beta.1.", "beta.2."), method = "sal", n.seps = 1) - - # EVPPI.sad <- BCEA::evppi(bcea_vacc, "beta.2.", inp$mat, method = "sad", n.seps = 1) - # save(EVPPI.sad, file = "tests/testthat/testdata/EVPPI_sad_default.RData") - load(file = test_path("testdata", "EVPPI_sad_default.RData")) - - EVPPI.sad_voi <- evppi(bcea_vacc, "beta.2.", inp$mat, method = "sad", n.seps = 1) - EVPPI.sal_voi <- evppi(bcea_vacc, "beta.1.", inp$mat, method = "sal", n.seps = 1) - - expect_s3_class(EVPPI.sad, "evppi") - expect_length(EVPPI.sad, 6) - expect_type(EVPPI.sad, "list") - - expect_s3_class(EVPPI.sad_voi, "evppi") - expect_type(EVPPI.sad_voi, "list") - - expect_equivalent(EVPPI.sad$evppi, EVPPI.sad_voi$evppi, tolerance = 0.001) - expect_equivalent(EVPPI.sad$k, EVPPI.sad_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI.sad$evi, EVPPI.sad_voi$evi, tolerance = 0.001) - expect_equivalent(EVPPI.sad$index, EVPPI.sad_voi$index) - - ##TODO: snapshot - # plot(EVPPI.so) - # plot(EVPPI.sad) - # plot(EVPPI.so_voi) - # plot(EVPPI.sad_voi) - - rm(EVPPI.sad) -}) - -test_that("Select parameters by position with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # evppi_idx <- BCEA::evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat) - # save(evppi_idx, file = "tests/testthat/testdata/EVPPI_idx.RData") - load(file = test_path("testdata", "EVPPI_idx.RData")) - - evppi_idx_voi <- evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat) - - expect_s3_class(evppi_idx, "evppi") - expect_length(evppi_idx, 10) - expect_type(evppi_idx, "list") - - expect_s3_class(evppi_idx_voi, "evppi") - expect_type(evppi_idx_voi, "list") -}) - -test_that("INLA/SPDE with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - skip_if_not_installed("INLA") - skip("INLA is crashing") - - if (require("INLA")) { - # EVPPI_inla <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla") - # save(EVPPI_inla, file = "tests/testthat/testdata/EVPPI_inla_default.RData") - load(file = test_path("testdata", "EVPPI_inla_default.RData")) - - EVPPI_inla_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla") - - expect_s3_class(EVPPI_inla, "evppi") - expect_length(EVPPI_inla, 10) - expect_type(EVPPI_inla, "list") - - expect_s3_class(EVPPI_inla_voi, "evppi") - expect_type(EVPPI_inla_voi, "list") - } -}) - -test_that("Different argument formats with vaccine data", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # GAM regression - # EVPPI_gam <- BCEA::evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat, method = "GAM") - # save(EVPPI_gam, file = "tests/testthat/testdata/EVPPI_gam.RData") - load(file = test_path("testdata", "EVPPI_gam.RData")) - - # lower case method name - EVPPI_gam_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "gam") - - expect_s3_class(EVPPI_gam_voi, "evppi") - expect_type(EVPPI_gam_voi, "list") - expect_equivalent(EVPPI_gam$k, EVPPI_gam_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI_gam$select, EVPPI_gam_voi$select) - - # Strong et al GP regression - - # EVPPI_gp <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "GP") - # save(EVPPI_gp, file = "tests/testthat/testdata/EVPPI_gp.RData") - load(file = test_path("testdata", "EVPPI_gp.RData")) - - # lower case method name - EVPPI_gp_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "gp") - - expect_s3_class(EVPPI_gp_voi, "evppi") - expect_type(EVPPI_gp_voi, "list") - - # subsetting input PSA simulations - - # set.seed(1234) - # EVPPI_psa <- BCEA::evppi(bcea_vacc, c("beta.1." , "beta.2."), inp$mat, N = 100) - # save(EVPPI_psa, file = "tests/testthat/testdata/EVPPI_psa.RData") - load(file = test_path("testdata", "EVPPI_psa.RData")) - - set.seed(1234) - EVPPI_psa_voi <- evppi(bcea_vacc, c("beta.1." , "beta.2."), inp$mat, N = 100) - - expect_equivalent(EVPPI_psa$select, EVPPI_psa_voi$select) - expect_equivalent(EVPPI_psa$evppi, EVPPI_psa_voi$evppi, tolerance = 0.001) - - expect_equivalent(EVPPI_psa$k, EVPPI_psa_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI_psa$evi, EVPPI_psa_voi$evi, tolerance = 0.001) - expect_equivalent(EVPPI_psa$index, EVPPI_psa_voi$index) -}) - -test_that("Mesh plotting with vaccine data", { - - skip("plot = TRUE mesh plot to be snapshot") - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # # GAM regression (default) - # # plot not produced - # EVPPI <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, plot = TRUE) - # EVPPI_voi <- evppi_voi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, plot = TRUE) - # EVPPI_voi_orig <- voi::evppi(bcea_vacc[c("e","c","k")], inputs = inp$mat, pars = c("beta.1.", "beta.2."), check = TRUE, plot_inla_mesh = TRUE) - # - # # INLA - # EVPPI_inla <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", plot = TRUE) - # EVPPI_inla_voi <- evppi_voi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", plot = TRUE) -}) - -test_that("Fitted values with vaccine data two parameters", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # GP - # set.seed(1234) - # EVPPI_gp_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = 39:40, - # input = inp$mat, - # method = "gp", - # residuals = TRUE) - # save(EVPPI_gp_residuals, file = "tests/testthat/testdata/EVPPI_gp_residuals.RData") - load(file = test_path("testdata", "EVPPI_gp_residuals.RData")) - - set.seed(1234) - EVPPI_gp_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = 39:40, - input = inp$mat, - method = "gp", - residuals = TRUE) - - expect_equivalent( - EVPPI_gp_residuals$select, - EVPPI_gp_voi_residuals$select) - - expect_equivalent( - EVPPI_gp_residuals$fitted.costs, - EVPPI_gp_voi_residuals$fitted.costs, - tolerance = 0.1) - - expect_equivalent( - EVPPI_gp_residuals$fitted.effects, - EVPPI_gp_voi_residuals$fitted.effects, - tolerance = 0.1) - - # SAD - # set.seed(1234) - # EVPPI_sad_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = "beta.2.", - # input = inp$mat, - # method = "sad", - # residuals = TRUE) - # save(EVPPI_sad_residuals, file = "tests/testthat/testdata/EVPPI_sad_residuals.RData") - load(file = test_path("testdata", "EVPPI_sad_residuals.RData")) - - set.seed(1234) - EVPPI_sad_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = "beta.2.", - input = inp$mat, - method = "sad", - residuals = TRUE) - - # no fitted values returned - expect_null(EVPPI_sad_residuals$fitted.costs) - expect_null(EVPPI_sad_residuals$fitted.effects) - - expect_null(EVPPI_sad_voi_residuals$fitted.costs) - expect_null(EVPPI_sad_voi_residuals$fitted.effects) - - # GAM - # set.seed(1234) - # EVPPI_gam_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = 39:40, - # input = inp$mat, - # method = "gam", - # residuals = TRUE) - # save(EVPPI_gam_residuals, file = "tests/testthat/testdata/EVPPI_gam_residuals.RData") - load(file = test_path("testdata", "EVPPI_gam_residuals.RData")) - - set.seed(1234) - EVPPI_gam_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = 39:40, - input = inp$mat, - method = "gam", - residuals = TRUE) - - expect_equivalent( - EVPPI_gam_residuals$fitted.costs, - EVPPI_gam_voi_residuals$fitted.costs, - tolerance = 0.001) - - expect_equivalent( - EVPPI_gam_residuals$fitted.effects, - EVPPI_gam_voi_residuals$fitted.effects, - tolerance = 0.001) - - skip_if_not_installed("INLA") - skip("INLA is crashing") - - if (require("INLA")) { - # set.seed(1234) - # EVPPI_inla_residuals <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", residuals = TRUE) - # save(EVPPI_inla_residuals, file = "tests/testthat/testdata/EVPPI_inla_residuals.RData") - load(file = test_path("testdata", "EVPPI_inla_residuals.RData")) - - set.seed(1234) - EVPPI_inla_voi_residuals <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", residuals = TRUE) - - expect_equivalent( - EVPPI_inla_residuals$select, - EVPPI_inla_voi_residuals$select) - - expect_equivalent( - EVPPI_inla_residuals$fitted.costs, - EVPPI_inla_voi_residuals$fitted.costs, - tolerance = 0.1) - - expect_equivalent( - EVPPI_inla_residuals$fitted.effects, - EVPPI_inla_voi_residuals$fitted.effects, - tolerance = 0.1) - } -}) - -test_that("Fitted values with vaccine data three parameters", { - - data(Vaccine, package = "BCEA") - treats <- c("Status quo", "Vaccination") - - # Run the health economic evaluation using BCEA - bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) - - inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) - - # GP - # set.seed(1234) - # EVPPI_gp_3_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = 39:41, - # input = inp$mat, - # method = "gp", - # residuals = TRUE) - # save(EVPPI_gp_3_residuals, file = "tests/testthat/testdata/EVPPI_gp_3_residuals.RData") - load(file = test_path("testdata", "EVPPI_gp_3_residuals.RData")) - - set.seed(1234) - EVPPI_gp_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = 39:41, - input = inp$mat, - method = "gp", - residuals = TRUE) - - expect_equivalent( - EVPPI_gp_3_residuals$fitted.costs, - EVPPI_gp_voi_residuals$fitted.costs, - tolerance = 0.1) - - expect_equivalent( - EVPPI_gp_3_residuals$fitted.effects, - EVPPI_gp_voi_residuals$fitted.effects, - tolerance = 0.1) - - # GAM - # set.seed(1234) - # EVPPI_gam_3_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = 39:41, - # input = inp$mat, - # method = "gam", - # residuals = TRUE) - # save(EVPPI_gam_3_residuals, file = "tests/testthat/testdata/EVPPI_gam_3_residuals.RData") - load(file = test_path("testdata", "EVPPI_gam_3_residuals.RData")) - - set.seed(1234) - EVPPI_gam_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = 39:41, - input = inp$mat, - method = "gam", - residuals = TRUE) - - expect_equivalent( - EVPPI_gam_3_residuals$fitted.costs, - EVPPI_gam_voi_residuals$fitted.costs, - tolerance = 0.1) - - expect_equivalent( - EVPPI_gam_3_residuals$fitted.effects, - EVPPI_gam_voi_residuals$fitted.effects, - tolerance = 0.1) - - skip_if_not_installed("INLA") - skip("INLA is crashing") - - if (require("INLA")) { - # set.seed(1234) - # EVPPI_inla_3_residuals <- - # BCEA::evppi( - # he = bcea_vacc, - # param_idx = 39:41, - # input = inp$mat, - # method = "inla", - # residuals = TRUE) - # save(EVPPI_inla_3_residuals, file = "tests/testthat/testdata/EVPPI_inla_3_residuals.RData") - load(file = test_path("testdata", "EVPPI_inla_3_residuals.RData")) - - set.seed(1234) - EVPPI_inla_voi_residuals <- - evppi( - he = bcea_vacc, - param_idx = 39:41, - input = inp$mat, - method = "inla", - residuals = TRUE) - - expect_equivalent( - EVPPI_inla_3_residuals$fitted.costs, - EVPPI_inla_voi_residuals$fitted.costs, - tolerance = 0.1) - - expect_equivalent( - EVPPI_inla_3_residuals$fitted.effects, - EVPPI_inla_voi_residuals$fitted.effects, - tolerance = 0.1) - } -}) - -test_that("More that two interventions with smoking data", { - - skip("more than two interventions to be revisited after {voi} update") - - data(Smoking, package = "BCEA") - treats <- - c("No intervention", "Self-help", - "Individual counselling", "Group counselling") - - inp <- createInputs(smoking_output, print_is_linear_comb = FALSE) - - bcea_smoke <- bcea(eff, cost, ref = 4, interventions = treats, Kmax = 500) # all interventions - - # bcea_smoke <- bcea(eff, cost, ref = 4, .comparison = 1, interventions = treats, Kmax = 500) - # bcea_smoke <- bcea(eff, cost, ref = 4, .comparison = c(2,3), interventions = treats, Kmax = 500) - - # expect_length(inp , 2) - # expect_named(inp, c("mat", "parameters")) - # expect_type(inp, "list") - - set.seed(1234) - # EVPPI_smoke <- BCEA::evppi(bcea_smoke, param_idx = c(2,3), inp$mat, h.value = 5e-7, method = "gam") - # save(EVPPI_smoke, file = "tests/testthat/testdata/EVPPI_smoke.RData") - # load(file = test_path("testdata", "EVPPI_smoke.RData")) - - set.seed(1234) - EVPPI_voi <- evppi(bcea_smoke, param_idx = c(2,3), inp$mat, h.value = 5e-7, method = "gam") - - # voiEVPPI <- voi::evppi(bcea_smoke[c("e","c","k")], pars = c("d.3.", "d.4."), inputs = inp$mat, h.value = 5e-7) - - expect_s3_class(EVPPI_voi, "evppi") - expect_type(EVPPI_voi, "list") - - ##TODO: error - expect_equivalent(EVPPI_smoke$evppi, EVPPI_voi$evppi, tolerance = 0.01) - - expect_equivalent(EVPPI_smoke$k, EVPPI_voi$k, tolerance = 0.001) - expect_equivalent(EVPPI_smoke$k, EVPPI_voi$k, tolerance = 0.001) - - expect_equivalent(EVPPI_smoke$evi, EVPPI_voi$evi, tolerance = 0.001) - expect_equivalent(EVPPI_smoke$select, EVPPI_voi$select) - expect_equivalent(EVPPI_smoke$index, EVPPI_voi$index) - - ##TODO: error - ##TODO: seems like the wrong order of columns? - ## what is the correct order? label columns? - expect_equivalent(EVPPI_smoke$fitted.costs, EVPPI_voi$fitted.costs, tolerance = 0.001) - expect_equivalent(EVPPI_smoke$fitted.effects, EVPPI_voi$fitted.effects, tolerance = 0.001) - - # plot(EVPPI_voi) -}) - - +# +# # mainly regression tests against old version of BCEA::evppi() +# # from version <= 2.4.5 +# # versus new evppi() calling voi::evppi internally +# +# +# # library(BCEA) +# if (interactive()) library(testthat) +# +# if (!requireNamespace("voi", quietly = TRUE)) { +# stop( +# "Package \"voi (>= 1.0.1)\" must be installed to use this function.", +# call. = FALSE +# ) +# } +# +# test_that("GAM regression (default) with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # expect_length(inp, 2) +# # expect_named(inp, c("mat", "parameters")) +# # expect_type(inp, "list") +# +# # EVPPI <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat) +# # save(EVPPI, file = "tests/testthat/testdata/EVPPI_GAM_default.RData") +# load(file = test_path("testdata", "EVPPI_GAM_default.RData")) +# +# EVPPI_voi <- evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat) +# +# EVPPI_voi_orig <- voi::evppi(bcea_vacc[c("e","c","k")], +# inputs = inp$mat, +# pars = c("beta.1.", "beta.2."), +# check = TRUE) +# +# expect_s3_class(EVPPI, "evppi") +# expect_length(EVPPI, 10) +# expect_type(EVPPI, "list") +# +# expect_s3_class(EVPPI_voi, "evppi") +# expect_type(EVPPI_voi, "list") +# +# expect_equivalent(EVPPI$evppi, EVPPI_voi$evppi, tolerance = 0.001) +# expect_equivalent(EVPPI_voi_orig$evppi, EVPPI_voi$evppi, tolerance = 0.001) +# +# expect_equivalent(EVPPI$k, EVPPI_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI_voi_orig$k, EVPPI_voi$k, tolerance = 0.001) +# +# expect_equivalent(EVPPI$evi, EVPPI_voi$evi, tolerance = 0.001) +# expect_equivalent(EVPPI$index, EVPPI_voi$index) +# expect_equivalent(EVPPI$fitted.costs, EVPPI_voi$fitted.costs, tolerance = 0.001) +# expect_equivalent(EVPPI$fitted.effects, EVPPI_voi$fitted.effects, tolerance = 0.001) +# expect_equivalent(EVPPI$select, EVPPI_voi$select) +# +# ##TODO: snapshot +# # plot(EVPPI) +# # plot(EVPPI_voi) +# +# rm(EVPPI) +# }) +# +# test_that("Strong & Oakley with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# expect_error(evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "so", n.blocks = 50), +# regexp = "only works for single-parameter EVPPI") +# +# # EVPPI.so <- BCEA::evppi(bcea_vacc, "beta.1.", inp$mat, method = "so", n.blocks = 50) +# # save(EVPPI.so, file = "tests/testthat/testdata/EVPPI_so_default.RData") +# load(file = test_path("testdata", "EVPPI_so_default.RData")) +# +# EVPPI.so_voi <- evppi(bcea_vacc, "beta.1.", inp$mat, method = "so", n.blocks = 50) +# +# expect_s3_class(EVPPI.so, "evppi") +# expect_length(EVPPI.so, 6) +# expect_type(EVPPI.so, "list") +# +# expect_s3_class(EVPPI.so_voi, "evppi") +# expect_type(EVPPI.so_voi, "list") +# +# expect_equivalent(EVPPI.so$evppi, EVPPI.so_voi$evppi, tolerance = 0.001) +# expect_equivalent(EVPPI.so$k, EVPPI.so_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI.so$evi, EVPPI.so_voi$evi, tolerance = 0.001) +# expect_equivalent(EVPPI.so$index, EVPPI.so_voi$index) +# +# rm(EVPPI.so) +# }) +# +# test_that("Sadatsafavi et al with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # voi::evppi only works for single-parameter EVPPI +# +# # EVPPI.sad <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "sad", n.seps = 1) +# # save(EVPPI.sad, file = "tests/testthat/testdata/EVPPI_sad_default.RData") +# # load(file = test_path("testdata", "EVPPI_sad_default.RData")) +# +# # TODO: error +# # EVPPI.sal <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, method = "sal", n.seps = 1) +# +# expect_error(evppi(bcea_vacc, param_idx = c("beta.1.", "beta.2."), inp$mat, method = "sal", n.seps = 1), +# regexp = "only works for single-parameter EVPPI") +# +# # voiEVPPI.sad <- voi::evppi(outputs = bcea_vacc[c("e","c","k")], inputs = inp$mat, +# # pars = c("beta.1.", "beta.2."), method = "sal", n.seps = 1) +# +# # EVPPI.sad <- BCEA::evppi(bcea_vacc, "beta.2.", inp$mat, method = "sad", n.seps = 1) +# # save(EVPPI.sad, file = "tests/testthat/testdata/EVPPI_sad_default.RData") +# load(file = test_path("testdata", "EVPPI_sad_default.RData")) +# +# EVPPI.sad_voi <- evppi(bcea_vacc, "beta.2.", inp$mat, method = "sad", n.seps = 1) +# EVPPI.sal_voi <- evppi(bcea_vacc, "beta.1.", inp$mat, method = "sal", n.seps = 1) +# +# expect_s3_class(EVPPI.sad, "evppi") +# expect_length(EVPPI.sad, 6) +# expect_type(EVPPI.sad, "list") +# +# expect_s3_class(EVPPI.sad_voi, "evppi") +# expect_type(EVPPI.sad_voi, "list") +# +# expect_equivalent(EVPPI.sad$evppi, EVPPI.sad_voi$evppi, tolerance = 0.001) +# expect_equivalent(EVPPI.sad$k, EVPPI.sad_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI.sad$evi, EVPPI.sad_voi$evi, tolerance = 0.001) +# expect_equivalent(EVPPI.sad$index, EVPPI.sad_voi$index) +# +# ##TODO: snapshot +# # plot(EVPPI.so) +# # plot(EVPPI.sad) +# # plot(EVPPI.so_voi) +# # plot(EVPPI.sad_voi) +# +# rm(EVPPI.sad) +# }) +# +# test_that("Select parameters by position with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # evppi_idx <- BCEA::evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat) +# # save(evppi_idx, file = "tests/testthat/testdata/EVPPI_idx.RData") +# load(file = test_path("testdata", "EVPPI_idx.RData")) +# +# evppi_idx_voi <- evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat) +# +# expect_s3_class(evppi_idx, "evppi") +# expect_length(evppi_idx, 10) +# expect_type(evppi_idx, "list") +# +# expect_s3_class(evppi_idx_voi, "evppi") +# expect_type(evppi_idx_voi, "list") +# }) +# +# test_that("INLA/SPDE with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# skip_if_not_installed("INLA") +# skip("INLA is crashing") +# +# if (require("INLA")) { +# # EVPPI_inla <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla") +# # save(EVPPI_inla, file = "tests/testthat/testdata/EVPPI_inla_default.RData") +# load(file = test_path("testdata", "EVPPI_inla_default.RData")) +# +# EVPPI_inla_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla") +# +# expect_s3_class(EVPPI_inla, "evppi") +# expect_length(EVPPI_inla, 10) +# expect_type(EVPPI_inla, "list") +# +# expect_s3_class(EVPPI_inla_voi, "evppi") +# expect_type(EVPPI_inla_voi, "list") +# } +# }) +# +# test_that("Different argument formats with vaccine data", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # GAM regression +# # EVPPI_gam <- BCEA::evppi(he = bcea_vacc, param_idx = 39:40, input = inp$mat, method = "GAM") +# # save(EVPPI_gam, file = "tests/testthat/testdata/EVPPI_gam.RData") +# load(file = test_path("testdata", "EVPPI_gam.RData")) +# +# # lower case method name +# EVPPI_gam_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "gam") +# +# expect_s3_class(EVPPI_gam_voi, "evppi") +# expect_type(EVPPI_gam_voi, "list") +# expect_equivalent(EVPPI_gam$k, EVPPI_gam_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI_gam$select, EVPPI_gam_voi$select) +# +# # Strong et al GP regression +# +# # EVPPI_gp <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "GP") +# # save(EVPPI_gp, file = "tests/testthat/testdata/EVPPI_gp.RData") +# load(file = test_path("testdata", "EVPPI_gp.RData")) +# +# # lower case method name +# EVPPI_gp_voi <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "gp") +# +# expect_s3_class(EVPPI_gp_voi, "evppi") +# expect_type(EVPPI_gp_voi, "list") +# +# # subsetting input PSA simulations +# +# # set.seed(1234) +# # EVPPI_psa <- BCEA::evppi(bcea_vacc, c("beta.1." , "beta.2."), inp$mat, N = 100) +# # save(EVPPI_psa, file = "tests/testthat/testdata/EVPPI_psa.RData") +# load(file = test_path("testdata", "EVPPI_psa.RData")) +# +# set.seed(1234) +# EVPPI_psa_voi <- evppi(bcea_vacc, c("beta.1." , "beta.2."), inp$mat, N = 100) +# +# expect_equivalent(EVPPI_psa$select, EVPPI_psa_voi$select) +# expect_equivalent(EVPPI_psa$evppi, EVPPI_psa_voi$evppi, tolerance = 0.001) +# +# expect_equivalent(EVPPI_psa$k, EVPPI_psa_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI_psa$evi, EVPPI_psa_voi$evi, tolerance = 0.001) +# expect_equivalent(EVPPI_psa$index, EVPPI_psa_voi$index) +# }) +# +# test_that("Mesh plotting with vaccine data", { +# +# skip("plot = TRUE mesh plot to be snapshot") +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # # GAM regression (default) +# # # plot not produced +# # EVPPI <- BCEA::evppi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, plot = TRUE) +# # EVPPI_voi <- evppi_voi(bcea_vacc, c("beta.1.", "beta.2."), inp$mat, plot = TRUE) +# # EVPPI_voi_orig <- voi::evppi(bcea_vacc[c("e","c","k")], inputs = inp$mat, pars = c("beta.1.", "beta.2."), check = TRUE, plot_inla_mesh = TRUE) +# # +# # # INLA +# # EVPPI_inla <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", plot = TRUE) +# # EVPPI_inla_voi <- evppi_voi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", plot = TRUE) +# }) +# +# test_that("Fitted values with vaccine data two parameters", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # GP +# # set.seed(1234) +# # EVPPI_gp_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = 39:40, +# # input = inp$mat, +# # method = "gp", +# # residuals = TRUE) +# # save(EVPPI_gp_residuals, file = "tests/testthat/testdata/EVPPI_gp_residuals.RData") +# load(file = test_path("testdata", "EVPPI_gp_residuals.RData")) +# +# set.seed(1234) +# EVPPI_gp_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = 39:40, +# input = inp$mat, +# method = "gp", +# residuals = TRUE) +# +# expect_equivalent( +# EVPPI_gp_residuals$select, +# EVPPI_gp_voi_residuals$select) +# +# expect_equivalent( +# EVPPI_gp_residuals$fitted.costs, +# EVPPI_gp_voi_residuals$fitted.costs, +# tolerance = 0.1) +# +# expect_equivalent( +# EVPPI_gp_residuals$fitted.effects, +# EVPPI_gp_voi_residuals$fitted.effects, +# tolerance = 0.1) +# +# # SAD +# # set.seed(1234) +# # EVPPI_sad_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = "beta.2.", +# # input = inp$mat, +# # method = "sad", +# # residuals = TRUE) +# # save(EVPPI_sad_residuals, file = "tests/testthat/testdata/EVPPI_sad_residuals.RData") +# load(file = test_path("testdata", "EVPPI_sad_residuals.RData")) +# +# set.seed(1234) +# EVPPI_sad_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = "beta.2.", +# input = inp$mat, +# method = "sad", +# residuals = TRUE) +# +# # no fitted values returned +# expect_null(EVPPI_sad_residuals$fitted.costs) +# expect_null(EVPPI_sad_residuals$fitted.effects) +# +# expect_null(EVPPI_sad_voi_residuals$fitted.costs) +# expect_null(EVPPI_sad_voi_residuals$fitted.effects) +# +# # GAM +# # set.seed(1234) +# # EVPPI_gam_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = 39:40, +# # input = inp$mat, +# # method = "gam", +# # residuals = TRUE) +# # save(EVPPI_gam_residuals, file = "tests/testthat/testdata/EVPPI_gam_residuals.RData") +# load(file = test_path("testdata", "EVPPI_gam_residuals.RData")) +# +# set.seed(1234) +# EVPPI_gam_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = 39:40, +# input = inp$mat, +# method = "gam", +# residuals = TRUE) +# +# expect_equivalent( +# EVPPI_gam_residuals$fitted.costs, +# EVPPI_gam_voi_residuals$fitted.costs, +# tolerance = 0.001) +# +# expect_equivalent( +# EVPPI_gam_residuals$fitted.effects, +# EVPPI_gam_voi_residuals$fitted.effects, +# tolerance = 0.001) +# +# skip_if_not_installed("INLA") +# skip("INLA is crashing") +# +# if (require("INLA")) { +# # set.seed(1234) +# # EVPPI_inla_residuals <- BCEA::evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", residuals = TRUE) +# # save(EVPPI_inla_residuals, file = "tests/testthat/testdata/EVPPI_inla_residuals.RData") +# load(file = test_path("testdata", "EVPPI_inla_residuals.RData")) +# +# set.seed(1234) +# EVPPI_inla_voi_residuals <- evppi(he = bcea_vacc, 39:40, input = inp$mat, method = "inla", residuals = TRUE) +# +# expect_equivalent( +# EVPPI_inla_residuals$select, +# EVPPI_inla_voi_residuals$select) +# +# expect_equivalent( +# EVPPI_inla_residuals$fitted.costs, +# EVPPI_inla_voi_residuals$fitted.costs, +# tolerance = 0.1) +# +# expect_equivalent( +# EVPPI_inla_residuals$fitted.effects, +# EVPPI_inla_voi_residuals$fitted.effects, +# tolerance = 0.1) +# } +# }) +# +# test_that("Fitted values with vaccine data three parameters", { +# +# data(Vaccine, package = "BCEA") +# treats <- c("Status quo", "Vaccination") +# +# # Run the health economic evaluation using BCEA +# bcea_vacc <- bcea(e.pts, c.pts, ref = 2, interventions = treats) +# +# inp <- createInputs(vaccine_mat, print_is_linear_comb = FALSE) +# +# # GP +# # set.seed(1234) +# # EVPPI_gp_3_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = 39:41, +# # input = inp$mat, +# # method = "gp", +# # residuals = TRUE) +# # save(EVPPI_gp_3_residuals, file = "tests/testthat/testdata/EVPPI_gp_3_residuals.RData") +# load(file = test_path("testdata", "EVPPI_gp_3_residuals.RData")) +# +# set.seed(1234) +# EVPPI_gp_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = 39:41, +# input = inp$mat, +# method = "gp", +# residuals = TRUE) +# +# expect_equivalent( +# EVPPI_gp_3_residuals$fitted.costs, +# EVPPI_gp_voi_residuals$fitted.costs, +# tolerance = 0.1) +# +# expect_equivalent( +# EVPPI_gp_3_residuals$fitted.effects, +# EVPPI_gp_voi_residuals$fitted.effects, +# tolerance = 0.1) +# +# # GAM +# # set.seed(1234) +# # EVPPI_gam_3_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = 39:41, +# # input = inp$mat, +# # method = "gam", +# # residuals = TRUE) +# # save(EVPPI_gam_3_residuals, file = "tests/testthat/testdata/EVPPI_gam_3_residuals.RData") +# load(file = test_path("testdata", "EVPPI_gam_3_residuals.RData")) +# +# set.seed(1234) +# EVPPI_gam_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = 39:41, +# input = inp$mat, +# method = "gam", +# residuals = TRUE) +# +# expect_equivalent( +# EVPPI_gam_3_residuals$fitted.costs, +# EVPPI_gam_voi_residuals$fitted.costs, +# tolerance = 0.1) +# +# expect_equivalent( +# EVPPI_gam_3_residuals$fitted.effects, +# EVPPI_gam_voi_residuals$fitted.effects, +# tolerance = 0.1) +# +# skip_if_not_installed("INLA") +# skip("INLA is crashing") +# +# if (require("INLA")) { +# # set.seed(1234) +# # EVPPI_inla_3_residuals <- +# # BCEA::evppi( +# # he = bcea_vacc, +# # param_idx = 39:41, +# # input = inp$mat, +# # method = "inla", +# # residuals = TRUE) +# # save(EVPPI_inla_3_residuals, file = "tests/testthat/testdata/EVPPI_inla_3_residuals.RData") +# load(file = test_path("testdata", "EVPPI_inla_3_residuals.RData")) +# +# set.seed(1234) +# EVPPI_inla_voi_residuals <- +# evppi( +# he = bcea_vacc, +# param_idx = 39:41, +# input = inp$mat, +# method = "inla", +# residuals = TRUE) +# +# expect_equivalent( +# EVPPI_inla_3_residuals$fitted.costs, +# EVPPI_inla_voi_residuals$fitted.costs, +# tolerance = 0.1) +# +# expect_equivalent( +# EVPPI_inla_3_residuals$fitted.effects, +# EVPPI_inla_voi_residuals$fitted.effects, +# tolerance = 0.1) +# } +# }) +# +# test_that("More that two interventions with smoking data", { +# +# skip("more than two interventions to be revisited after {voi} update") +# +# data(Smoking, package = "BCEA") +# treats <- +# c("No intervention", "Self-help", +# "Individual counselling", "Group counselling") +# +# inp <- createInputs(smoking_output, print_is_linear_comb = FALSE) +# +# bcea_smoke <- bcea(eff, cost, ref = 4, interventions = treats, Kmax = 500) # all interventions +# +# # bcea_smoke <- bcea(eff, cost, ref = 4, .comparison = 1, interventions = treats, Kmax = 500) +# # bcea_smoke <- bcea(eff, cost, ref = 4, .comparison = c(2,3), interventions = treats, Kmax = 500) +# +# # expect_length(inp , 2) +# # expect_named(inp, c("mat", "parameters")) +# # expect_type(inp, "list") +# +# set.seed(1234) +# # EVPPI_smoke <- BCEA::evppi(bcea_smoke, param_idx = c(2,3), inp$mat, h.value = 5e-7, method = "gam") +# # save(EVPPI_smoke, file = "tests/testthat/testdata/EVPPI_smoke.RData") +# # load(file = test_path("testdata", "EVPPI_smoke.RData")) +# +# set.seed(1234) +# EVPPI_voi <- evppi(bcea_smoke, param_idx = c(2,3), inp$mat, h.value = 5e-7, method = "gam") +# +# # voiEVPPI <- voi::evppi(bcea_smoke[c("e","c","k")], pars = c("d.3.", "d.4."), inputs = inp$mat, h.value = 5e-7) +# +# expect_s3_class(EVPPI_voi, "evppi") +# expect_type(EVPPI_voi, "list") +# +# ##TODO: error +# expect_equivalent(EVPPI_smoke$evppi, EVPPI_voi$evppi, tolerance = 0.01) +# +# expect_equivalent(EVPPI_smoke$k, EVPPI_voi$k, tolerance = 0.001) +# expect_equivalent(EVPPI_smoke$k, EVPPI_voi$k, tolerance = 0.001) +# +# expect_equivalent(EVPPI_smoke$evi, EVPPI_voi$evi, tolerance = 0.001) +# expect_equivalent(EVPPI_smoke$select, EVPPI_voi$select) +# expect_equivalent(EVPPI_smoke$index, EVPPI_voi$index) +# +# ##TODO: error +# ##TODO: seems like the wrong order of columns? +# ## what is the correct order? label columns? +# expect_equivalent(EVPPI_smoke$fitted.costs, EVPPI_voi$fitted.costs, tolerance = 0.001) +# expect_equivalent(EVPPI_smoke$fitted.effects, EVPPI_voi$fitted.effects, tolerance = 0.001) +# +# # plot(EVPPI_voi) +# }) +# +#