tests/testthat/test-Backfill-validity.R

In crmPack: Object-Oriented Implementation of Dose Escalation Designs

# Opening ----

## v_opening_min_dose ----

test_that("v_opening_min_dose passes for valid object", {
  object <- OpeningMinDose(min_dose = 0)
  expect_true(v_opening_min_dose(object))

  object <- OpeningMinDose(min_dose = 50)
  expect_true(v_opening_min_dose(object))
})

test_that("v_opening_min_dose returns message for non-valid min_dose", {
  err_msg <- "min_dose needs to be a non-negative numeric vector"
  object <- OpeningMinDose(min_dose = 10)

  # Changing `min_dose` so that it is negative.
  object@min_dose <- -5
  expect_equal(v_opening_min_dose(object), err_msg)

  # Changing `min_dose` so that it is NA.
  object@min_dose <- NA_real_
  expect_equal(v_opening_min_dose(object), err_msg)

  # Changing `min_dose` so that it is non-finite.
  object@min_dose <- c(Inf, 0)
  expect_equal(v_opening_min_dose(object), err_msg)
})

## v_opening_min_cohorts ----

test_that("v_opening_min_cohorts passes for valid object", {
  object <- OpeningMinCohorts(min_cohorts = 2)
  expect_true(v_opening_min_cohorts(object))

  object <- OpeningMinCohorts(min_cohorts = 5)
  expect_true(v_opening_min_cohorts(object))
})

test_that("v_opening_min_cohorts returns message for non-valid min_cohorts", {
  err_msg <- "min_cohorts needs to be a positive integer scalar"
  object <- OpeningMinCohorts(min_cohorts = 3)

  # Changing `min_cohorts` so that it is zero.
  object@min_cohorts <- 0L
  expect_equal(v_opening_min_cohorts(object), err_msg)

  # Changing `min_cohorts` so that it is negative.
  object@min_cohorts <- -1L
  expect_equal(v_opening_min_cohorts(object), err_msg)
})

## v_opening_min_responses ----

test_that("v_opening_min_responses passes for valid object", {
  object <- OpeningMinResponses(min_responses = 1, include_lower_doses = FALSE)
  expect_true(v_opening_min_responses(object))

  object <- OpeningMinResponses(min_responses = 5, include_lower_doses = TRUE)
  expect_true(v_opening_min_responses(object))
})

test_that("v_opening_min_responses returns message for non-valid min_responses", {
  err_msg_responses <- "min_responses needs to be a positive integer scalar"
  object <- OpeningMinResponses(min_responses = 2)

  # Changing `min_responses` so that it is zero.
  object@min_responses <- 0L
  expect_equal(v_opening_min_responses(object), err_msg_responses)

  # Changing `min_responses` so that it is negative.
  object@min_responses <- -1L
  expect_equal(v_opening_min_responses(object), err_msg_responses)
})

test_that("v_opening_min_responses returns message for non-valid include_lower_doses", {
  err_msg_flag <- "include_lower_doses needs to be a logical flag"
  object <- OpeningMinResponses(min_responses = 2, include_lower_doses = FALSE)

  # Changing `include_lower_doses` so that it is NA.
  object@include_lower_doses <- NA
  expect_equal(v_opening_min_responses(object), err_msg_flag)

  # Changing `include_lower_doses` so that it is a vector.
  object@include_lower_doses <- c(TRUE, FALSE)
  expect_equal(v_opening_min_responses(object), err_msg_flag)

  object@include_lower_doses <- TRUE
  err_msg_flag <- "min_responses needs to be a positive integer scalar"

  # Changing `min_responses` so that it is NA.
  object@min_responses <- NA_integer_
  expect_equal(v_opening_min_responses(object), err_msg_flag)

  # Changing `min_responses` so that it is not a scalar.
  object@min_responses <- c(2L, 3L)
  expect_equal(v_opening_min_responses(object), err_msg_flag)
})

# Recruitment ----

## v_recruitment_ratio ----

test_that("v_recruitment_ratio passes for valid object", {
  object <- RecruitmentRatio(ratio = 0)
  expect_true(v_recruitment_ratio(object))

  object <- RecruitmentRatio(ratio = 0.5)
  expect_true(v_recruitment_ratio(object))

  object <- RecruitmentRatio(ratio = 1)
  expect_true(v_recruitment_ratio(object))

  object <- RecruitmentRatio(ratio = 2.5)
  expect_true(v_recruitment_ratio(object))
})

test_that("v_recruitment_ratio fails for negative ratio", {
  object <- RecruitmentRatio(ratio = 1)
  object@ratio <- -0.5
  err_msg <- "ratio needs to be a non-negative"
  expect_match(v_recruitment_ratio(object), err_msg)
})

test_that("v_recruitment_ratio fails for non-scalar ratio", {
  object <- RecruitmentRatio(ratio = 1)
  object@ratio <- c(0.5, 1)
  err_msg <- "ratio needs to be a non-negative"
  expect_match(v_recruitment_ratio(object), err_msg)
})

test_that("v_recruitment_ratio fails for NA ratio", {
  object <- RecruitmentRatio(ratio = 1)
  object@ratio <- NA_real_
  err_msg <- "ratio needs to be a non-negative"
  expect_match(v_recruitment_ratio(object), err_msg)
})

# Backfill ----

## v_backfill ----

test_that("v_backfill passes for valid default Backfill object", {
  object <- Backfill()
  expect_true(v_backfill(object))
})

test_that("v_backfill passes for valid Backfill object with custom parameters", {
  object <- Backfill(
    opening = OpeningMinCohorts(min_cohorts = 2),
    recruitment = RecruitmentRatio(ratio = 0.5),
    max_size = 50L,
    priority = "lowest"
  )
  expect_true(v_backfill(object))
})

test_that("v_backfill fails for non-positive max_size", {
  object <- Backfill()
  object@max_size <- -100L
  err_msg <- "max_size needs to be a positive integer scalar"
  expect_equal(v_backfill(object), err_msg)
})

test_that("v_backfill fails for invalid priority", {
  object <- Backfill()
  object@priority <- "invalid_priority"
  err_msg <- "priority needs to be one of 'highest', 'lowest', or 'random'"
  expect_equal(v_backfill(object), err_msg)
})