tests/testthat/test-LeafNode.R

In rdecision: Decision Analytic Modelling in Health Economics

test_that("missing, non-character or empty labels are rejected", {
  expect_error(LeafNode$new(), class = "invalid_label")
  expect_error(LeafNode$new(42L), class = "invalid_label")
  expect_error(LeafNode$new(""), class = "invalid_label")
  expect_silent(LeafNode$new("my node"))
})

test_that("object parameters can be set dynamically", {
  t1 <- LeafNode$new(label = "poorly")
  expect_error(t1$set_utility(), class = "invalid_utility")
  expect_error(t1$set_utility(NA_real_), class = "invalid_utility")
  t1$set_utility(0.5)
  expect_intol(t1$utility(), 0.5, 0.01)
  expect_error(t1$set_interval(), class = "invalid_interval")
  expect_error(t1$set_interval(NA_real_), class = "invalid_interval")
  expect_error(t1$set_interval(42L), class = "invalid_interval")
  t1$set_interval(as.difftime(7.0, units = "days"))
  expect_intol(as.numeric(t1$interval(), units = "weeks"), 1.0, 0.01)
})

test_that("utility values and distributions are supported", {
  # invalid type
  expect_error(LeafNode$new("QALY", "ill"), class = "invalid_utility")
  # valid type, out of range
  expect_error(LeafNode$new("QALY", 2.0), class = "invalid_utility")
  # check that utility is returned
  t1 <- LeafNode$new("QALY", 0.5)
  expect_intol(t1$utility(), 0.5, 0.01)
  mv <- t1$modvars()
  expect_length(mv, 0L)
  # check that ModVars are supported
  u <- ConstModVar$new("poorly", "U", 0.25)
  t1 <- LeafNode$new("QALY", utility = u)
  expect_intol(t1$utility(), 0.25, 0.01)
  um <- ExprModVar$new("depressed", "U", rlang::quo(0.9 * u))
  t1 <- LeafNode$new("QALY", utility = um)
  mv <- t1$modvars()
  expect_length(mv, 2L)
  # check that using ModVar permits utilities > 1 (e.g. maternity)
  umat <- ConstModVar$new("Pregnant", "U", 2.0)
  t1 <- LeafNode$new("QALY", utility = umat)
  expect_intol(t1$utility(), 2.0, 0.01)
})

test_that("utility can be set and got after node is created", {
  t1 <- LeafNode$new(label = "poorly", utility = 0.75)
  expect_intol(t1$utility(), 0.75, 0.01)
  t1$set_utility(utility = 0.50)
  expect_intol(t1$utility(), 0.50, 0.01)
  expect_error(t1$set_utility("very ill"))
  expect_intol(t1$utility(), 0.50, 0.01)
  expect_length(t1$modvars(), 0L)
  t1$set_utility(utility = ConstModVar$new("poorly", "U", 0.75))
  expect_intol(t1$utility(), 0.75, 0.01)
  expect_length(t1$modvars(), 1L)
})

test_that("intervals are supported", {
  expect_error(
    LeafNode$new("QALY", utility = 1.0, interval = 42.0),
    class = "invalid_interval"
  )
  t1 <- LeafNode$new(
    "QALY", utility = 1.0, interval = as.difftime(7L, units = "days")
  )
  expect_intol(as.numeric(t1$interval(), units = "weeks"), 1.0, 0.01)
})

test_that("QALYs are calculated correctly", {
  t1 <- LeafNode$new(
    "QALY", utility = 0.5, interval = as.difftime(365.25 / 2.0, units = "days")
  )
  expect_intol(t1$QALY(), 0.25, 0.01)
  r <- 3.5 / 100.0
  t2 <- LeafNode$new(
    "QALY", utility = 1.0, interval = as.difftime(365.25, units = "days"),
    ru = r
  )
  expect_intol(t2$QALY(), ((1.0 - exp(-r)) / r), 0.001)
  u <- ConstModVar$new("", "", 1.0)
  t3 <- LeafNode$new(
    "QALY", utility = u, interval = as.difftime(365.25, units = "days"),
    ru = r
  )
  expect_intol(t3$QALY(), ((1.0 - exp(-r)) / r), 0.001)
})

test_that("graphical representation of the node is as expected", {
  n <- LeafNode$new(label = "leaf")
  grDevices::pdf(file = NULL)
  grid::grid.newpage()
  vp <- grid::viewport()
  grid::pushViewport(vp)
  x <- grid::unit(0.5, "npc")
  y <- grid::unit(0.5, "npc")
  bb <- n$grob(x = x, y = y, bb = TRUE)
  expect_s3_class(bb, "unit")
  expect_length(bb, 4L)
  ng <- n$grob(x = x, y = y)
  expect_s3_class(ng, "grob")
  grid::grid.draw(ng)
  rg <- grid::rectGrob(
    x = bb[[1L]], y = bb[[3L]],
    width = bb[[2L]] - bb[[1L]], height = bb[[4L]] - bb[[3L]],
    just = c("left", "bottom")
  )
  grid::grid.draw(rg)
  grid::popViewport()
  grDevices::dev.off()
})