tests/testthat/test_expand_last_dose_to_cohort.R

In brockk/dosefinding: A Modular Approach to Dose-Finding Clinical Trials

test_that("expand_last_dose_to_cohort_selector does what it should.", {

  # Contrast the behaviour of nested models:
  model0 <- follow_path("1NN 2NN 3NN")

  model1 <- model0 %>%
    expand_last_dose_to_cohort(n = 3)
  model1b <- model0 %>%
    expand_last_dose_to_cohort(n = 4)

  target <- 0.25
  model2 <- model1 %>%
    get_mtpi2(
      num_doses = 5, target = target, epsilon1 = 0.05,
      epsilon2 = 0.05, exclusion_certainty = 0.95
    )
  model2b <- model1b %>%
    get_mtpi2(
      num_doses = 5, target = target, epsilon1 = 0.05,
      epsilon2 = 0.05, exclusion_certainty = 0.95
    )



  outcomes <- ""
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1N"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1NN"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    2
  )
  expect_true(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    2
  )
  expect_true(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    2
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1NT"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1NTN"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1b %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2b %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1NTT"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1b %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2b %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1TTT"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model1b %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    as.integer(NA)
  )
  expect_false(
    model2 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2b %>% fit(outcomes) %>% recommended_dose(),
    1
  )
  expect_true(
    model2b %>% fit(outcomes) %>% continue()
  )



  outcomes <- "1TTTT"
  expect_equal(
    model0 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model0 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1 %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model1 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model1b %>% fit(outcomes) %>% recommended_dose(),
    NA
  )
  expect_false(
    model1b %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2 %>% fit(outcomes) %>% recommended_dose(),
    as.integer(NA)
  )
  expect_false(
    model2 %>% fit(outcomes) %>% continue()
  )
  expect_equal(
    model2b %>% fit(outcomes) %>% recommended_dose(),
    as.integer(NA)
  )
  expect_false(
    model2b %>% fit(outcomes) %>% continue()
  )


})

test_that('expand_last_dose_to_cohort_selector supports correct interface.', {

  # skeleton <- c(0.05, 0.1, 0.25, 0.4, 0.6)
  # target <- 0.25

  model_fitter <- follow_path(path = "1NNN 2NNN 3NNN") %>%
    expand_last_dose_to_cohort(n = 5)

  # Example 1, using outcome string
  x <- fit(model_fitter, '1NNN 2NNN')

  expect_equal(num_patients(x), 6)
  expect_true(is.integer(num_patients(x)))

  expect_equal(cohort(x), c(1,1,1, 2,2,2))
  expect_true(is.integer(cohort(x)))
  expect_equal(length(cohort(x)), num_patients(x))

  expect_equal(doses_given(x), c(1,1,1, 2,2,2))
  expect_true(is.integer(doses_given(x)))
  expect_equal(length(doses_given(x)), num_patients(x))

  expect_equal(tox(x), c(0,0,0, 0,0,0))
  expect_true(is.integer(tox(x)))
  expect_equal(length(tox(x)), num_patients(x))

  expect_true(is.numeric(weight(x)))
  expect_equal(length(weight(x)), num_patients(x))

  expect_equal(num_tox(x), 0)
  expect_true(is.integer(num_tox(x)))

  expect_true(all(model_frame(x) - data.frame(patient = c(1,2,3,4,5,6),
                                              cohort = c(1,1,1,2,2,2),
                                              dose = c(1,1,1,2,2,2),
                                              tox = c(0,0,0,0,0,0),
                                              weight = c(1,1,1,1,1,1)) == 0))
  expect_equal(nrow(model_frame(x)), num_patients(x))

  expect_equal(num_doses(x), 3)
  expect_true(is.integer(num_doses(x)))

  expect_equal(dose_indices(x), 1:3)
  expect_true(is.integer(dose_indices(x)))
  expect_equal(length(dose_indices(x)), num_doses(x))

  expect_true(is.integer(recommended_dose(x)))
  expect_equal(length(recommended_dose(x)), 1)

  expect_equal(continue(x), TRUE)
  expect_true(is.logical(continue(x)))

  expect_equal(n_at_dose(x), c(3,3,0))
  expect_true(is.integer(n_at_dose(x)))
  expect_equal(length(n_at_dose(x)), num_doses(x))

  expect_equal(n_at_dose(x, dose = 0), 0)
  expect_true(is.integer(n_at_dose(x, dose = 0)))
  expect_equal(length(n_at_dose(x, dose = 0)), 1)

  expect_equal(n_at_dose(x, dose = 1), 3)
  expect_true(is.integer(n_at_dose(x, dose = 1)))
  expect_equal(length(n_at_dose(x, dose = 1)), 1)

  expect_equal(n_at_dose(x, dose = 'recommended'), 0)
  expect_true(is.integer(n_at_dose(x, dose = 'recommended')))
  expect_equal(length(n_at_dose(x, dose = 'recommended')), 1)

  expect_equal(n_at_recommended_dose(x), 0)
  expect_true(is.integer(n_at_recommended_dose(x)))
  expect_equal(length(n_at_recommended_dose(x)), 1)

  expect_equal(is_randomising(x), FALSE)
  expect_true(is.logical(is_randomising(x)))
  expect_equal(length(is_randomising(x)), 1)

  expect_equal(unname(prob_administer(x)), c(0.5,0.5,0))
  expect_true(is.numeric(prob_administer(x)))
  expect_equal(length(prob_administer(x)), num_doses(x))

  expect_equal(tox_at_dose(x), c(0,0,0))
  expect_true(is.integer(tox_at_dose(x)))
  expect_equal(length(tox_at_dose(x)), num_doses(x))

  expect_true(is.numeric(empiric_tox_rate(x)))
  expect_equal(length(empiric_tox_rate(x)), num_doses(x))

  expect_true(is.numeric(mean_prob_tox(x)))
  expect_equal(length(mean_prob_tox(x)), num_doses(x))

  expect_true(is.numeric(median_prob_tox(x)))
  expect_equal(length(median_prob_tox(x)), num_doses(x))

  expect_true(is.logical(dose_admissible(x)))
  expect_equal(length(dose_admissible(x)), num_doses(x))

  expect_true(is.numeric(prob_tox_quantile(x, p = 0.9)))
  expect_equal(length(prob_tox_quantile(x, p = 0.9)), num_doses(x))

  expect_true(is.numeric(prob_tox_exceeds(x, 0.5)))
  expect_equal(length(prob_tox_exceeds(x, 0.5)), num_doses(x))

  expect_true(is.logical(supports_sampling(x)))

  expect_error(is.data.frame(prob_tox_samples(x)))
  expect_error(is.data.frame(prob_tox_samples(x, tall = TRUE)))

  # Expect summary to not error. This is how that is tested, apparently:
  expect_error(summary(x), NA)
  expect_output(print(x))
  expect_true(tibble::is_tibble(as_tibble(x)))
  expect_true(nrow(as_tibble(x)) >= num_doses(x))



  # Example 2, using trivial outcome string
  x <- fit(model_fitter, '')

  expect_equal(num_patients(x), 0)
  expect_true(is.integer(num_patients(x)))

  expect_equal(cohort(x), integer(0))
  expect_true(is.integer(cohort(x)))
  expect_equal(length(cohort(x)), num_patients(x))

  expect_equal(doses_given(x), integer(0))
  expect_true(is.integer(doses_given(x)))
  expect_equal(length(doses_given(x)), num_patients(x))

  expect_equal(tox(x), integer(0))
  expect_true(is.integer(tox(x)))
  expect_equal(length(tox(x)), num_patients(x))

  expect_true(is.numeric(weight(x)))
  expect_equal(length(weight(x)), num_patients(x))

  expect_equal(num_tox(x), 0)
  expect_true(is.integer(num_tox(x)))

  mf <- model_frame(x)
  expect_equal(nrow(mf), 0)
  expect_equal(ncol(mf), 5)

  expect_equal(num_doses(x), 3)
  expect_true(is.integer(num_doses(x)))

  expect_equal(dose_indices(x), 1:3)
  expect_true(is.integer(dose_indices(x)))
  expect_equal(length(dose_indices(x)), num_doses(x))

  expect_equal(recommended_dose(x), 1)
  expect_true(is.integer(recommended_dose(x)))
  expect_equal(length(recommended_dose(x)), 1)

  expect_equal(continue(x), TRUE)
  expect_true(is.logical(continue(x)))

  expect_equal(n_at_dose(x), c(0,0,0))
  expect_true(is.integer(n_at_dose(x)))
  expect_equal(length(n_at_dose(x)), num_doses(x))

  expect_equal(n_at_dose(x, dose = 0), 0)
  expect_true(is.integer(n_at_dose(x, dose = 0)))
  expect_equal(length(n_at_dose(x, dose = 0)), 1)

  expect_equal(n_at_dose(x, dose = 1), 0)
  expect_true(is.integer(n_at_dose(x, dose = 1)))
  expect_equal(length(n_at_dose(x, dose = 1)), 1)

  expect_equal(n_at_dose(x, dose = 'recommended'), 0)
  expect_true(is.integer(n_at_dose(x, dose = 'recommended')))
  expect_equal(length(n_at_dose(x, dose = 'recommended')), 1)

  expect_equal(n_at_recommended_dose(x), 0)
  expect_true(is.integer(n_at_recommended_dose(x)))
  expect_equal(length(n_at_recommended_dose(x)), 1)

  expect_equal(is_randomising(x), FALSE)
  expect_true(is.logical(is_randomising(x)))
  expect_equal(length(is_randomising(x)), 1)

  expect_true(is.numeric(prob_administer(x)))
  expect_equal(length(prob_administer(x)), num_doses(x))

  expect_equal(tox_at_dose(x), c(0,0,0))
  expect_true(is.integer(tox_at_dose(x)))
  expect_equal(length(tox_at_dose(x)), num_doses(x))

  expect_true(is.numeric(empiric_tox_rate(x)))
  expect_equal(length(empiric_tox_rate(x)), num_doses(x))

  expect_true(is.numeric(mean_prob_tox(x)))
  expect_equal(length(mean_prob_tox(x)), num_doses(x))

  expect_true(is.numeric(median_prob_tox(x)))
  expect_equal(length(median_prob_tox(x)), num_doses(x))

  expect_true(is.logical(dose_admissible(x)))
  expect_equal(length(dose_admissible(x)), num_doses(x))

  expect_true(is.numeric(prob_tox_quantile(x, p = 0.9)))
  expect_equal(length(prob_tox_quantile(x, p = 0.9)), num_doses(x))

  expect_true(is.numeric(prob_tox_exceeds(x, 0.5)))
  expect_equal(length(prob_tox_exceeds(x, 0.5)), num_doses(x))

  expect_true(is.logical(supports_sampling(x)))

  expect_error(is.data.frame(prob_tox_samples(x)))
  expect_error(is.data.frame(prob_tox_samples(x, tall = TRUE)))

  # Expect summary to not error. This is how that is tested, apparently:
  expect_error(summary(x), NA)
  expect_output(print(x))
  expect_true(tibble::is_tibble(as_tibble(x)))
  expect_true(nrow(as_tibble(x)) >= num_doses(x))



  # Example 3, using tibble of outcomes
  outcomes <- tibble(
    cohort = c(1,1,1, 2,2,2),
    dose = c(1,1,1, 2,2,2),
    tox = c(0,0,0, 0,0,1)
  )
  x <- fit(model_fitter, outcomes)

  expect_equal(num_patients(x), 6)
  expect_true(is.integer(num_patients(x)))

  expect_equal(cohort(x), c(1,1,1, 2,2,2))
  expect_true(is.integer(cohort(x)))
  expect_equal(length(cohort(x)), num_patients(x))

  expect_equal(doses_given(x), c(1,1,1, 2,2,2))
  expect_true(is.integer(doses_given(x)))
  expect_equal(length(doses_given(x)), num_patients(x))

  expect_equal(tox(x), c(0,0,0, 0,0,1))
  expect_true(is.integer(tox(x)))
  expect_equal(length(tox(x)), num_patients(x))

  expect_true(is.numeric(weight(x)))
  expect_equal(length(weight(x)), num_patients(x))

  expect_equal(num_tox(x), 1)
  expect_true(is.integer(num_tox(x)))

  expect_true(all((model_frame(x) - data.frame(patient = c(1,2,3,4,5,6),
                                               cohort = c(1,1,1,2,2,2),
                                               dose = c(1,1,1,2,2,2),
                                               tox = c(0,0,0,0,0,1),
                                               weight = c(1,1,1,1,1,1))) == 0))
  expect_equal(nrow(model_frame(x)), num_patients(x))

  expect_equal(num_doses(x), 3)
  expect_true(is.integer(num_doses(x)))

  expect_equal(dose_indices(x), 1:3)
  expect_true(is.integer(dose_indices(x)))
  expect_equal(length(dose_indices(x)), num_doses(x))

  expect_equal(recommended_dose(x), 2)
  expect_true(is.integer(recommended_dose(x)))
  expect_equal(length(recommended_dose(x)), 1)

  expect_equal(continue(x), TRUE)
  expect_true(is.logical(continue(x)))

  expect_equal(n_at_dose(x), c(3,3,0))
  expect_true(is.integer(n_at_dose(x)))
  expect_equal(length(n_at_dose(x)), num_doses(x))

  expect_equal(n_at_dose(x, dose = 0), 0)
  expect_true(is.integer(n_at_dose(x, dose = 0)))
  expect_equal(length(n_at_dose(x, dose = 0)), 1)

  expect_equal(n_at_dose(x, dose = 1), 3)
  expect_true(is.integer(n_at_dose(x, dose = 1)))
  expect_equal(length(n_at_dose(x, dose = 1)), 1)

  expect_equal(n_at_dose(x, dose = 'recommended'), 3)
  expect_true(is.integer(n_at_dose(x, dose = 'recommended')))
  expect_equal(length(n_at_dose(x, dose = 'recommended')), 1)

  expect_equal(n_at_recommended_dose(x), 3)
  expect_true(is.integer(n_at_recommended_dose(x)))
  expect_equal(length(n_at_recommended_dose(x)), 1)

  expect_equal(is_randomising(x), FALSE)
  expect_true(is.logical(is_randomising(x)))
  expect_equal(length(is_randomising(x)), 1)

  expect_equal(unname(prob_administer(x)), c(0.5,0.5,0))
  expect_true(is.numeric(prob_administer(x)))
  expect_equal(length(prob_administer(x)), num_doses(x))

  expect_equal(tox_at_dose(x), c(0,1,0))
  expect_true(is.integer(tox_at_dose(x)))
  expect_equal(length(tox_at_dose(x)), num_doses(x))

  expect_true(is.numeric(empiric_tox_rate(x)))
  expect_equal(length(empiric_tox_rate(x)), num_doses(x))

  expect_true(is.numeric(mean_prob_tox(x)))
  expect_equal(length(mean_prob_tox(x)), num_doses(x))

  expect_true(is.numeric(median_prob_tox(x)))
  expect_equal(length(median_prob_tox(x)), num_doses(x))

  expect_true(is.logical(dose_admissible(x)))
  expect_equal(length(dose_admissible(x)), num_doses(x))

  expect_true(is.numeric(prob_tox_quantile(x, p = 0.9)))
  expect_equal(length(prob_tox_quantile(x, p = 0.9)), num_doses(x))

  expect_true(is.numeric(prob_tox_exceeds(x, 0.5)))
  expect_equal(length(prob_tox_exceeds(x, 0.5)), num_doses(x))

  expect_true(is.logical(supports_sampling(x)))

  expect_error(is.data.frame(prob_tox_samples(x)))
  expect_error(is.data.frame(prob_tox_samples(x, tall = TRUE)))

  # Expect summary to not error. This is how that is tested, apparently:
  expect_error(summary(x), NA)
  expect_output(print(x))
  expect_true(tibble::is_tibble(as_tibble(x)))
  expect_true(nrow(as_tibble(x)) >= num_doses(x))

})