Nothing
test_that('trialr_nbg_selector matches bcrm and NBG paper.', {
# This example is taken from the manual for the bcrm package.
# It fits the NBG model to data in Neuenschwander et al. (2008).
# Reading values off the plot in lower right panel of Figure 1 in
# Neuenschwander et al. (2008), these are the posterior means of prob(tox)
# that we seek by fitting the model to data:
nbg_post_mean = c(0.01, 0.02, 0.05, 0.13, 0.19, 0.25, 0.30, 0.35, 0.47, 0.53,
0.68, 0.74, 0.85, 0.89, 0.92)
# Data
dose <- c(1, 2.5, 5, 10, 15, 20, 25, 30, 40, 50, 75, 100, 150, 200, 250)
d_star = 250
target <- 0.30
df <- data.frame(
patient=1:18,
dose = rep(c(1:4, 7), c(3, 4, 5, 4, 2)),
tox = rep(0:1, c(16, 2)))
# # bcrm version
# sdose <- log(dose / 250)
# ## Bivariate lognormal prior
# mu <- c(2.15, 0.52)
# Sigma <- rbind(c(0.84^2, 0.134), c(0.134, 0.80^2))
# fit1 <- bcrm::bcrm(stop = list(nmax=18),
# data = df,
# sdose = sdose,
# dose = dose,
# ff = "logit2",
# prior.alpha = list(4, mu, Sigma),
# target.tox = target,
# constrain = FALSE,
# pointest = "mean",
# method = "rjags")
# bcrm_dose <- fit1$ndose[[1]]$ndose
# bcrm_prob_tox <- fit1$ndose[[1]]$mean
# Yields:
bcrm_dose <- 7
bcrm_prob_tox <- c(0.01276366, 0.03170250, 0.06454400, 0.13103260, 0.19505604,
0.25486603, 0.30990977, 0.36015142, 0.44716663, 0.51852928,
0.64632144, 0.72710146, 0.81804596, 0.86567496, 0.89421686)
# trialr version
outcomes <- '1NNN 2NNNN 3NNNN 4NNNN 7TT'
fit2 <- get_trialr_nbg(real_doses = dose, d_star = d_star, target = target,
alpha_mean = 2.15, alpha_sd = 0.84,
beta_mean = 0.52, beta_sd = 0.8,
seed = 2020) %>%
fit(outcomes = outcomes)
# MTD matches?
expect_equal(bcrm_dose, recommended_dose(fit2))
# mean_prob_tox matches?
epsilon <- 0.04
expect_true(all(abs(bcrm_prob_tox - mean_prob_tox(fit2)) < epsilon))
# mean_prob_tox matches NBG publication?
epsilon <- 0.04
expect_true(all(abs(nbg_post_mean - mean_prob_tox(fit2)) < epsilon))
})
test_that('empiric trialr_nbg_selector supports correct interface.', {
real_doses <- c(1, 2.5, 5, 10, 15)
d_star <- 15
target <- 0.25
model_fitter <- get_trialr_nbg(real_doses = real_doses, d_star = d_star,
target = target,
alpha_mean = 2.15, alpha_sd = 0.84,
beta_mean = 0.52, beta_sd = 0.8)
# Example 1, using outcome string
x <- fit(model_fitter, '1NNN 2NTT')
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), unname(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_equal(num_tox(x), 2)
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,1,1))) == 0))
expect_equal(nrow(model_frame(x)), num_patients(x))
expect_equal(num_doses(x), 5)
expect_true(is.integer(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))
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_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, 1,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,1,1))
expect_true(is.integer(tox(x)))
expect_equal(length(tox(x)), num_patients(x))
expect_equal(num_tox(x), 2)
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,1,1))) == 0))
expect_equal(nrow(model_frame(x)), num_patients(x))
expect_equal(num_doses(x), 5)
expect_true(is.integer(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))
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_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.