Nothing
#' @title Calculate dose-transition pathways for an EffTox study
#'
#' @description Calculate dose-transition pathways for an EffTox study.
#' The function \code{\link{efftox_dtps_to_dataframe}} performs a similar
#' function, but is much less-flexible.
#'
#' @param cohort_sizes vector of future cohort sizes, i.e. positive integers.
#' E.g. To calculate paths for the the next cohort of two followed by another
#' cohort of three, use \code{cohort_sizes = c(2, 3)}.
#' @param previous_outcomes Outcomes observed hitherto in the syntax required
#' by \code{\link{efftox_parse_outcomes}}.
#' @param next_dose the dose-level to be given to the immediately next cohort.
#' @param user_dose_func optional delegate for deciding dose. A function that
#' takes a \code{\link{efftox_fit}} as the sole argument and returns the integer
#' (1-based) dose-level to be given next, or NA to show that no dose should be
#' chosen and the trial stopped. This function gives the user the opportunity to
#' build in custom behaviour to tailor the dose selection decision in response
#' to the insights garnered by the fit model, or recommend that a trial path
#' be halted immediately. If omitted, the dose ordinarily chosen by the model is
#' used. An example is given below.
#' @param verbose logical, TRUE to get progress messages.
#' @param i_am_patient logical, TRUE to show your tolerance for waiting for over 100
#' models to fit. Set to FALSE by default.
#' @param ... extra params passed to \code{rstan::sampling}.
#'
#' @return dose pathways in a \code{data.frame}.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # Calculate paths for the first cohort of 3 in Thall et al 2014 example
#' paths1 <- efftox_dtps(cohort_sizes = c(3), next_dose = 1,
#' real_doses = c(1.0, 2.0, 4.0, 6.6, 10.0),
#' efficacy_hurdle = 0.5, toxicity_hurdle = 0.3,
#' p_e = 0.1, p_t = 0.1,
#' eff0 = 0.5, tox1 = 0.65,
#' eff_star = 0.7, tox_star = 0.25,
#' alpha_mean = -7.9593, alpha_sd = 3.5487,
#' beta_mean = 1.5482, beta_sd = 3.5018,
#' gamma_mean = 0.7367, gamma_sd = 2.5423,
#' zeta_mean = 3.4181, zeta_sd = 2.4406,
#' eta_mean = 0, eta_sd = 0.2,
#' psi_mean = 0, psi_sd = 1, seed = 123)
#'
#'
#'
#' # Calculate paths for the next two cohorts of 2, in an in-progress trial
#' # Warning: this create 100 paths. It will run for a minute or two.
#' paths2 <- efftox_dtps(cohort_sizes = c(2, 2),
#' previous_outcomes = '1NN 2EE',
#' next_dose = 1,
#' real_doses = c(1.0, 2.0, 4.0, 6.6, 10.0),
#' efficacy_hurdle = 0.5, toxicity_hurdle = 0.3,
#' p_e = 0.1, p_t = 0.1,
#' eff0 = 0.5, tox1 = 0.65,
#' eff_star = 0.7, tox_star = 0.25,
#' alpha_mean = -7.9593, alpha_sd = 3.5487,
#' beta_mean = 1.5482, beta_sd = 3.5018,
#' gamma_mean = 0.7367, gamma_sd = 2.5423,
#' zeta_mean = 3.4181, zeta_sd = 2.4406,
#' eta_mean = 0, eta_sd = 0.2,
#' psi_mean = 0, psi_sd = 1, seed = 123,
#' i_am_patient = TRUE)
#'
#' # Paths can be converted to a tibble
#' library(tibble)
#' library(dplyr)
#' df <- as_tibble(paths2)
#' df %>% print(n = 200)
#'
#' # And shaped in a wide format
#' spread_paths(df %>% select(-fit, -parent_fit, -dose_index)) %>%
#' print(n = 100)
#' # Incredibly, there are 100 ways these two cohorts of two can end up.
#'
#'
#'
#' # An example with a custom dose selection function.
#' # Define a function to select the maximal utility dose, no matter what.
#' # Note: this diverges from the original authors' intentions; we provide this
#' # for illustration only!
#' max_utility_dose <- function(efftox_fit) {
#' return(which.max(efftox_fit$utility))
#' }
#' # Fit the paths, providing the user_dose_func parameter
#' # Warning: this create 100 paths. It will run for a minute or two.
#' paths3 <- efftox_dtps(cohort_sizes = c(2, 2),
#' previous_outcomes = '1NN 2EE',
#' next_dose = 1,
#' real_doses = c(1.0, 2.0, 4.0, 6.6, 10.0),
#' efficacy_hurdle = 0.5, toxicity_hurdle = 0.3,
#' p_e = 0.1, p_t = 0.1,
#' eff0 = 0.5, tox1 = 0.65,
#' eff_star = 0.7, tox_star = 0.25,
#' alpha_mean = -7.9593, alpha_sd = 3.5487,
#' beta_mean = 1.5482, beta_sd = 3.5018,
#' gamma_mean = 0.7367, gamma_sd = 2.5423,
#' zeta_mean = 3.4181, zeta_sd = 2.4406,
#' eta_mean = 0, eta_sd = 0.2,
#' psi_mean = 0, psi_sd = 1,
#' user_dose_func = max_utility_dose,
#' seed = 123, i_am_patient = TRUE)
#'
#' # We can see where the dose-selections differ at the second future cohort
#' # by joining these paths to those calculated in the previous example:
#' left_join(
#' as_tibble(paths2)%>%
#' select(.node, .parent, .depth, outcomes, model_dose = next_dose),
#' as_tibble(paths3) %>%
#' select(.node, user_dose = next_dose),
#' by = '.node'
#' ) %>% spread_paths() %>%
#' filter(model_dose2 != user_dose2)
#' # They differ in many places. The user defined functions sometimes selects
#' # higher doses; sometimes lower.
#' }
#'
#' @seealso
#' \code{\link{efftox_parse_outcomes}},
#' \code{\link{stan_efftox}},
#' \code{\link{efftox_path_analysis}},
#' \code{\link{dose_finding_path_node}}
#'
#' @references
#' Yap C, Billingham LJ, Cheung YK, Craddock C, O’Quigley J.
#' Dose transition pathways: The missing link between complex dose-finding
#' designs and simple decision-making. Clinical Cancer Research.
#' 2017;23(24):7440-7447. doi:10.1158/1078-0432.CCR-17-0582
#'
#' Brock K, Billingham L, Copland M, Siddique S, Sirovica M, Yap C.
#' Implementing the EffTox dose-finding design in the Matchpoint trial.
#' BMC Medical Research Methodology. 2017;17(1):112.
#' doi:10.1186/s12874-017-0381-x
#'
efftox_dtps <- function(cohort_sizes,
previous_outcomes = '',
next_dose = NULL,
user_dose_func = NULL,
verbose = FALSE,
i_am_patient = FALSE,
...) {
if(!all(cohort_sizes == ceiling(cohort_sizes)))
stop('cohort_sizes must be stricly positive integers.')
if(!all(cohort_sizes > 0))
stop('cohort_sizes must be stricly positive integers.')
if(nchar(previous_outcomes) > 0)
dat <- efftox_parse_outcomes(previous_outcomes)
else
dat <- list(doses = c(), eff = c(), tox = c(), num_patients = 0)
previous_doses <- dat$doses
previous_eff <- dat$eff
previous_tox <- dat$tox
previous_num_patients <- dat$num_patients
# Calculate feasible outcome combinations by cohort
outcomes <- c('E', 'T', 'N', 'B')
cohort_paths <- lapply(cohort_sizes,
function(x) gtools::combinations(n = 4, r = x,
v = outcomes,
repeats.allowed=TRUE))
# Flatten cohort outcomes
cohort_paths <- lapply(cohort_paths, function(x) apply(x, 1, paste0,
collapse = ''))
# Calculate pathways
cohort_paths <- expand.grid(cohort_paths, stringsAsFactors = FALSE)
num_paths <- nrow(cohort_paths)
if(num_paths >= 50 & num_paths < 100) {
message(paste0('You have requested ', num_paths,
' model evaluations. Be patient.'))
}
if(num_paths >= 100 & !i_am_patient) {
stop(paste0('You have requested ', num_paths,
' model evaluations but also flagged your impatience.',
' Run again with i_am_patient = TRUE'))
}
# Cache DTP calculations to avoid needless repetition
cache <- list()
# Root node is the current scenario
root_node_id <- 1
fit <- stan_efftox(outcome_str = previous_outcomes, ...)
if(is.null(next_dose)) {
if(is.null(user_dose_func))
next_dose <- fit$recommended_dose
else
next_dose <- user_dose_func(fit)
}
root <- dose_finding_path_node(node_id = root_node_id,
parent_node_id = NA,
depth = 0,
outcomes = '',
next_dose = next_dose,
fit = fit,
parent_fit = NULL)
cache[['']] <- root
node_id <- root_node_id + 1
for(i in 1:nrow(cohort_paths)) {
cohort_path <- cohort_paths[i, ]
cohort_dose <- next_dose
dtp <- ""
parent <- root
for(j in 1:length(cohort_path)) {
# If the dose is NA, this trial has stopped.
if(!is.na(cohort_dose)) {
dtp <- ifelse(nchar(dtp) > 0,
paste0(dtp, ' ', cohort_dose, cohort_path[j]),
paste0(cohort_dose, cohort_path[j])
)
if(dtp %in% names(cache)) {
# Fetch from cache
if(verbose) print(paste0('Fetching ', dtp, ' from cache'))
parent <- cache[[dtp]]
cohort_dose <- parent$next_dose
} else {
# Fit model for path, and cache.
these_outcomes <- efftox_parse_outcomes(dtp)
dat$doses <- array(c(previous_doses, these_outcomes$doses))
dat$eff <- array(c(previous_eff, these_outcomes$eff))
dat$tox <- array(c(previous_tox, these_outcomes$tox))
dat$num_patients <- previous_num_patients +
these_outcomes$num_patients
if(verbose) print(paste0('Running ', dtp))
fit <- stan_efftox(doses_given = dat$doses, eff = dat$eff,
tox = dat$tox, ...)
if(is.null(user_dose_func))
cohort_dose <- fit$recommended_dose
else
cohort_dose <- user_dose_func(fit)
# Cache
node <- dose_finding_path_node(node_id = node_id,
parent_node_id = parent$.node,
depth = j,
outcomes = as.character(cohort_path[j]),
next_dose = cohort_dose,
fit = fit,
parent_fit = parent$fit)
cache[[dtp]] <- node
parent <- node
node_id <- node_id + 1
}
}
}
}
class(cache) <- c("dose_finding_paths", "list")
cache
}
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.