tests/testthat/test-bcea.R

In BCEA: Bayesian Cost Effectiveness Analysis

## retains ordering?
## names outputs?


# library(dplyr)
# library(reshape2)


test_that("input errors", {
  
  load(test_path("ce.RData"))
  
  expect_dims_error <- function(x, y) {
    expect_error(
      bcea(x, y,
           plot = FALSE),
      regexp = "eff and cost are not the same dimensions.")
  }
  
  expect_dims_error(eff, cost[c(1,2,1), ])
  expect_dims_error(eff, cost[, c(1,2,1)])
  expect_dims_error(eff[c(1,2,1), ], cost)
  expect_dims_error(eff[, c(1,2,1)], cost)
  
  expect_error(
    bcea(eff, cost,
         interventions = "aaa",
         plot = FALSE),
    regexp = "interventions names wrong length.")
  
  expect_error(
    bcea(eff, cost,
         ref = 0,
         plot = FALSE),
    regexp = "reference is not in available interventions.")
  
  expect_error(
    bcea(eff, cost,
         ref = 3,
         plot = FALSE),
    regexp = "reference is not in available interventions.")
  
  # expect_error(bcea(e, c, ref = 1.1, plot = FALSE),
  #              regexp = "reference is not in available interventions.")
  
  expect_error(
    bcea(c(0,0), c(1,2),
         plot = FALSE),
    regexp = "eff and cost must be matrices.")
  
  expect_error(
    bcea(matrix(c(0,0)), matrix(c(1,2)),
         plot = FALSE),
    regexp = "Require at least 2 comparators.")
})


# realistic input data

test_that("basic return", {
  
  load(test_path("ce.RData"))
  
  res <- 
    bcea(e = eff,
         c = cost)
  
  expect_s3_class(res, "bcea")
  expect_type(res, "list")
  
  expect_length(res, 24)
  expect_named(res,
               c("n_sim", "n_comparators", "n_comparisons", "delta_e", "delta_c",
                 "ICER", "Kmax", "k", "ceac", "ib", "eib", "kstar", "best", "U", "vi",
                 "Ustar", "ol", "evi", "ref", "comp", "step", "interventions", "e", "c"))
  
  expect_equal(res$n_sim, nrow(cost))
  
  expect_n_sim_equal <- function (object)
    expect_equal(NROW(object), nrow(cost))
  
  expect_k_equal <- function (object)
    expect_equal(NROW(object), length(res$k))
  
  expect_n_sim_equal(res$delta_c)
  expect_n_sim_equal(res$delta_e)
  expect_n_sim_equal(res$U)
  expect_n_sim_equal(res$vi)
  expect_n_sim_equal(res$Ustar)
  expect_n_sim_equal(res$e)
  expect_n_sim_equal(res$c)
  
  expect_k_equal(res$ce)
  expect_k_equal(res$eib)
  expect_k_equal(res$evi)
  expect_k_equal(res$best)
  expect_k_equal(res$ib)
  
  ##TODO: should we swap rows and columns to match other variables?
  expect_k_equal(t(res$vi))
  expect_k_equal(t(res$Ustar))
  expect_k_equal(t(res$ol))
})


test_that("ib", {
  
  # single wtp
  
  c_tmp <- matrix(c(0, 0, 100, 10), nrow = 2)
  e_tmp <- matrix(c(0, 0, 1,   -2), nrow = 2)
  
  res <- 
    bcea(e = e_tmp,
         c = c_tmp, k = 5)
  
  k <- 5
  n_comparisons <- 1
  delta_e <- c(-1, 2)
  delta_c <- c(-100, -10) # this actually a saving for intervention
  n_sim <- 2
  
  ib_1 <- k*delta_e[1] - delta_c[1] # 5*(-1) - (-100) = 95
  ib_2 <- k*delta_e[2] - delta_c[2] # 5*2 - (-10) = 20
  
  expect_equivalent(c(ib_1, ib_2), res$ib)
  
  
  # multiple wtp
  
  k <- c(5, 10)
  K <- length(k)
  
  res <- 
    bcea(e = e_tmp,
         c = c_tmp, k = k)
  
  ib_1 <- k*delta_e[1] - delta_c[1] # 95, 10*(-1) - (-100) = 90
  ib_2 <- k*delta_e[2] - delta_c[2] # 20, 10*2 - (-10) = 30
  
  expect_equivalent(cbind(ib_1, ib_2), drop(res$ib))
  
  
  # multiple comparisons
  
  c_tmp <- matrix(c(0, 0, 100, 10,  0,  1), nrow = 2)
  e_tmp <- matrix(c(0, 0,   1, -2, -3, -4), nrow = 2)
  n_comparisons <- 2
  
  res <- 
    bcea(e = e_tmp,
         c = c_tmp, k = k)
  
  # sim x comparison
  delta_e <- matrix(c(-1, 3,
                      2, 4), nrow = 2, byrow = TRUE)
  delta_c <- matrix(c(-100,  0,
                      -10,  -1), nrow = 2,  byrow = TRUE)
  
  ib_11 <- k*delta_e[1, 1] - delta_c[1, 1] # 15 30
  ib_12 <- k*delta_e[1, 2] - delta_c[1, 2] # 15 30
  ib_21 <- k*delta_e[2, 1] - delta_c[2, 1] # 15 30
  ib_22 <- k*delta_e[2, 2] - delta_c[2, 2] # 21 41
  
  expect_equivalent(cbind(ib_11, ib_21), res$ib[, , 1])
  expect_equivalent(cbind(ib_12, ib_22), res$ib[, , 2])
})


# library(rstan)

test_that("jags, bugs, stan methods", {

  ##TODO: remove missing cost error
  # bcea(jagsfit)
  
  # mocked inputs
  load(test_path("testdata", "bugsfit.RData"))
  load(test_path("testdata", "jagsfit.RData"))
  # load(test_path("data", "stanfit.RData"))
  
  expect_s3_class(bcea.rjags(jagsfit), class = "bcea")
  expect_s3_class(bcea.bugs(bugsfit), class = "bcea")
  # expect_s3_class(bcea.rstan(stanfit), class = "bcea")
})

test_that("k and wtp arguments", {
  
  load(test_path("ce.RData"))
  
  m <- bcea(eff, cost, plot = FALSE)
  
  expect_equal(m$Kmax, 50000)
  expect_length(m$k, 501)
  
  m <- bcea(eff, cost, k = 0:1000, plot = FALSE)
  expect_equal(m$Kmax, 1000)
  expect_length(m$k, 1001)
  
  expect_message(
    bcea(eff, cost, wtp = 0:1000, plot = FALSE),
    "wtp argument soft deprecated. Please use k instead in future.")
})

test_that("using e and c still works", {
  
  load(test_path("ce.RData"))
  
  e <- eff
  c <- cost
  bcea_res <- bcea(eff = eff, cost = cost)
  
  expect_equal(bcea(e, c), bcea_res)
  expect_equal(bcea(e=e, c=c), bcea_res)
  expect_equal(bcea(c=c, e=e), bcea_res)
})

test_that("named reference", {
  
  load(test_path("ce.RData"))
  
  expect_equal(bcea(eff, cost, ref = 1, interventions = c("a", "b")),
               bcea(eff, cost, ref = "a", interventions = c("a", "b")))
  
  expect_equal(bcea(eff, cost, ref = 2, interventions = c("a", "b")),
               bcea(eff, cost, ref = "b", interventions = c("a", "b")))
  
  expect_message(bcea(eff, cost, ref = "c", interventions = c("a", "b")),
                 "No reference selected. Defaulting to first intervention.")
  
  expect_message(bcea(eff, cost, ref = "c"),
                 "No reference selected. Defaulting to first intervention.")
})