test_that('BOIN recommendations match published example.', { # p.25 of Han, Pan, Zhang, Liu & Yuan (2019) num_doses <- 5 target <- 0.3 boin_fitter <- get_boin(num_doses = num_doses, target = target) x <- fit(boin_fitter, '1NNN') expect_equal(recommended_dose(x), 2) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 2." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT') expect_equal(recommended_dose(x), 2) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 2." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN 3NNN') expect_equal(recommended_dose(x), 4) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 4." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN 3NNN 4TTT') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN 3NNN 4TTT 3NTN') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN 3NNN 4TTT 3NTN 3NNT') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) x <- fit(boin_fitter, '1NNN 2NNN 3NTT 2NTN 3NNN 3NNN 4TTT 3NTN 3NNT 3TNN') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) check_dose_selector_consistency(x) }) test_that('boin_selector supports correct interface.', { num_doses <- 5 target <- 0.3 model_fitter <- get_boin(num_doses = num_doses, target = target) # Example 1, using outcome string x <- fit(model_fitter, '1NNN 2NTT') expect_equal(tox_target(x), 0.3) 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,1,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_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,1,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), 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(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,2,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(prob_tox_samples(x)) expect_error(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.3) 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_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_equal(dose_indices(x), 1:5) expect_true(is.integer(dose_indices(x))) expect_equal(length(dose_indices(x)), num_doses(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(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_error(prob_tox_samples(x)) expect_error(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 outcomes <- tibble( cohort = c(1,1,1, 2,2,2), dose = c(1,1,1, 2,2,2), tox = c(0,0, 0,0, 1,1) ) x <- fit(model_fitter, outcomes) expect_equal(tox_target(x), 0.3) 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,1,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_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,1,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), 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(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,2,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(prob_tox_samples(x)) expect_error(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)) }) test_that('BOIN advises stopping when indicated', { num_doses <- 5 target <- 0.3 # Under these parameters, 0/1 tox will see escalation, 1/2 tox will see # descalation, and 3/3 or 3/4 will see elimination. # BOIN::get.boundary(target = target, ncohort = 1, cohortsize = 5) boin_fitter <- get_boin(num_doses = num_doses, target = target, use_stopping_rule = TRUE) # Design should continue x <- fit(boin_fitter, '1T') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should continue x <- fit(boin_fitter, '1TT') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should stop x <- fit(boin_fitter, '1TTT') expect_true(is.na(recommended_dose(x))) expect_false(continue(x)) expect_output( print(x), "The model advocates stopping and recommending no dose." ) expect_equal(dose_admissible(x), rep(FALSE, num_doses(x))) # Design should escalate x <- fit(boin_fitter, '1N') expect_equal(recommended_dose(x), 2) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 2." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should de-escalate x <- fit(boin_fitter, '1N 2TN') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should not yet stop x <- fit(boin_fitter, '1N 2TN 1TT') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Now design should stop x <- fit(boin_fitter, '1N 2TN 1TTT') expect_true(is.na(recommended_dose(x))) expect_false(continue(x)) expect_output( print(x), "The model advocates stopping and recommending no dose." ) expect_equal(dose_admissible(x), rep(FALSE, num_doses(x))) # If those 3 in 4 DLTs occurred at a higher dose, trial should continue but # toxic dose and those doses above should be inadmissible x <- fit(boin_fitter, '1N 4TTTT') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) expect_equal(dose_admissible(x), c(TRUE, TRUE, TRUE, FALSE, FALSE)) }) test_that('BOIN stopping rule can be turned off.', { num_doses <- 5 target <- 0.3 # Under these parameters, 0/1 tox will see escalation, 1/2 tox will see # descalation, and 3/3 or 3/4 will see elimination. # BOIN::get.boundary(target = target, ncohort = 1, cohortsize = 5) boin_fitter <- get_boin(num_doses = num_doses, target = target, use_stopping_rule = FALSE) # Design should escalate x <- fit(boin_fitter, '1N') expect_equal(recommended_dose(x), 2) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 2." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should de-escalate x <- fit(boin_fitter, '1N 2TN') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should not stop here x <- fit(boin_fitter, '1N 2TN 1TT') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Design should not stop here either x <- fit(boin_fitter, '1N 2TN 1TTT') expect_equal(recommended_dose(x), 1) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 1." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # If those 3 in 4 DLTs occurred at a higher dose, the trial should still # continue and all doses should be admissible x <- fit(boin_fitter, '1N 4TTTT') expect_equal(recommended_dose(x), 3) expect_true(continue(x)) expect_output( print(x), "The model advocates continuing at dose 3." ) expect_equal(dose_admissible(x), rep(TRUE, num_doses(x))) # Compare to tests above, this shows that the stopping rule has been disabled. }) test_that('BOIN prob_tox_exceeds matches boin package', { num_doses <- 5 target <- 0.3 boin_fitter <- get_boin(num_doses = num_doses, target = target) outcomes <- data.frame( cohort = c(1,1, 2,2, 3,3, 5,5), dose = c(1,1, 2,2, 3,3, 5,5), tox = c(0,0, 0,0, 1,1, 1,0) ) x <- fit(boin_fitter, outcomes) prob_tox_1 <- prob_tox_exceeds(x, threshold = target) prob_tox_2 <- as.character(x$boin_fit$p_overdose) prob_tox_2[prob_tox_2 == '----'] <- NA prob_tox_2 <- as.numeric(prob_tox_2) # Expect NAs in same place: expect_true(all(is.na(prob_tox_1) == is.na(prob_tox_2))) # And similar values where not NA expect_true(all(abs(prob_tox_1[!is.na(prob_tox_1)] - prob_tox_2[!is.na(prob_tox_2)]) < 0.01)) }) test_that('boin_selector respects eliminated doses', { model <- get_boin(num_doses = 3, target = 0.25, use_stopping_rule = TRUE) # After 3/3 tox, it should descalate but never re-escalate: fit <- model %>% fit('2TTT') expect_equal(fit %>% recommended_dose(), 1) expect_true(fit %>% continue()) expect_output( print(fit), "The model advocates continuing at dose 1." ) expect_equal(fit %>% dose_admissible(), c(TRUE, FALSE, FALSE)) fit <- model %>% fit('2TTT 1N') expect_equal(fit %>% recommended_dose(), 1) expect_true(fit %>% continue()) expect_output( print(fit), "The model advocates continuing at dose 1." ) expect_equal(fit %>% dose_admissible(), c(TRUE, FALSE, FALSE)) fit <- model %>% fit('2TTT 1NN') expect_equal(fit %>% recommended_dose(), 1) expect_true(fit %>% continue()) expect_output( print(fit), "The model advocates continuing at dose 1." ) expect_equal(fit %>% dose_admissible(), c(TRUE, FALSE, FALSE)) fit <- model %>% fit('2TTT 1NNN') expect_equal(fit %>% recommended_dose(), 1) expect_true(fit %>% continue()) expect_output( print(fit), "The model advocates continuing at dose 1." ) expect_equal(fit %>% dose_admissible(), c(TRUE, FALSE, FALSE)) fit <- model %>% fit('2TTT 1NNNNNNNNNNN') expect_equal(fit %>% recommended_dose(), 1) expect_true(fit %>% continue()) expect_output( print(fit), "The model advocates continuing at dose 1." ) expect_equal(fit %>% dose_admissible(), c(TRUE, FALSE, FALSE)) })