Nothing
test_that('dont_skip_selector does what it should.', {
skeleton <- c(0.05, 0.1, 0.25, 0.4, 0.6)
target <- 0.25
# Escalation CRM example
## Just CRM
model0 <- get_dfcrm(skeleton = skeleton, target = target)
fit0 <- model0 %>% fit('1NNN')
## CRM Skipping not allowed
model1 <- get_dfcrm(skeleton = skeleton, target = target) %>%
dont_skip_doses()
fit1 <- model1 %>% fit('1NNN')
expect_equal(recommended_dose(fit1), 2)
expect_equal(continue(fit1), TRUE)
expect_true(recommended_dose(fit0) >= recommended_dose(fit1))
## Skipping forcibly allowed, effectively replicating model0
model2 <- get_dfcrm(skeleton = skeleton, target = target) %>%
dont_skip_doses(when_escalating = FALSE, when_deescalating = FALSE)
fit2 <- model2 %>% fit('1NNN')
expect_equal(recommended_dose(fit0), recommended_dose(fit2))
expect_equal(continue(fit0), continue(fit2))
## Handle a parent that wants to stop
model3 <- get_dfcrm(skeleton = skeleton, target = target) %>%
stop_when_too_toxic(dose = 1, tox_threshold = target, confidence = 0.9) %>%
dont_skip_doses(when_escalating = TRUE, when_deescalating = TRUE)
fit3 <- model3 %>% fit('1TTT')
expect_true(is.na(recommended_dose(fit3)))
expect_false(continue(fit3))
# De-escalation CRM example
## Just CRM
fit3 <- model0 %>% fit('1NNN 2N 3TTT')
## CRM Skipping not allowed
model4 <- get_dfcrm(skeleton = skeleton, target = target) %>%
dont_skip_doses(when_deescalating = TRUE)
fit4 <- model4 %>% fit('1NNN 2N 3TTT')
expect_equal(recommended_dose(fit4), 2)
expect_equal(continue(fit4), TRUE)
expect_true(recommended_dose(fit3) <= recommended_dose(fit4))
## Skipping forcibly allowed, effectively replicating fit3
model5 <- get_dfcrm(skeleton = skeleton, target = target) %>%
dont_skip_doses(when_escalating = FALSE, when_deescalating = FALSE)
fit5 <- model2 %>% fit('1NNN 2N 3TTT')
expect_equal(recommended_dose(fit3), recommended_dose(fit5))
expect_equal(continue(fit3), continue(fit5))
## Handle a parent that wants to stop
model6 <- get_dfcrm(skeleton = skeleton, target = target) %>%
stop_when_too_toxic(dose = 1, tox_threshold = target, confidence = 0.9) %>%
dont_skip_doses(when_escalating = TRUE, when_deescalating = TRUE)
fit6 <- model6 %>% fit('1TTT 2N 3TTT')
expect_true(is.na(recommended_dose(fit6)))
expect_false(continue(fit6))
})
test_that('dont_skip_selector supports correct interface.', {
skeleton <- c(0.05, 0.1, 0.25, 0.4, 0.6)
target <- 0.25
model_fitter <- get_dfcrm(skeleton = skeleton, target = target) %>%
dont_skip_doses(when_escalating = TRUE, when_deescalating = FALSE)
# Example 1, using outcome string
x <- fit(model_fitter, '1NNN 2NNN')
expect_equal(tox_target(x), 0.25)
expect_true(is.numeric(tox_target(x)))
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_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)) == 0))
expect_equal(nrow(model_frame(x)), num_patients(x))
expect_equal(num_doses(x), 5)
expect_true(is.integer(num_doses(x)))
expect_equal(dose_indices(x), 1:5)
expect_true(is.integer(dose_indices(x)))
expect_equal(length(dose_indices(x)), num_doses(x))
expect_equal(recommended_dose(x), 3)
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,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), 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,0,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,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_true(is.data.frame(prob_tox_samples(x)))
expect_true(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(tox_target(x), 0.25)
expect_true(is.numeric(tox_target(x)))
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_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), 4)
expect_equal(num_doses(x), 5)
expect_true(is.integer(num_doses(x)))
expect_equal(dose_indices(x), 1:5)
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,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,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_true(is.data.frame(prob_tox_samples(x)))
expect_true(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(tox_target(x), 0.25)
expect_true(is.numeric(tox_target(x)))
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_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))) == 0))
expect_equal(nrow(model_frame(x)), num_patients(x))
expect_equal(num_doses(x), 5)
expect_true(is.integer(num_doses(x)))
expect_equal(dose_indices(x), 1:5)
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,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), 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,0,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,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_true(is.data.frame(prob_tox_samples(x)))
expect_true(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))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.