R/phase1_sim.R

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

#' @importFrom stats rbinom
#' @importFrom magrittr %>%
#' @importFrom utils tail
phase1_sim <- function(
  selector_factory,
  true_prob_tox,
  patient_sample = PatientSample$new(),
  sample_patient_arrivals = function(df) cohorts_of_n(n=3, mean_time_delta=1),
  previous_outcomes = '',
  next_dose = NULL,
  i_like_big_trials = FALSE, # Safety mechanism to avoid infinite trials
  return_all_fits = FALSE
) {
  if(is.character(previous_outcomes)) {
    base_df <- parse_phase1_outcomes(previous_outcomes, as_list = FALSE)
  } else if(is.data.frame(previous_outcomes)) {
    base_df <- spruce_outcomes_df(previous_outcomes)
  } else{
    base_df <- parse_phase1_outcomes('', as_list = FALSE)
  }
  dose <- base_df$dose
  tox <- base_df$tox
  cohort <- base_df$cohort
  next_cohort <- ifelse(length(cohort) > 0, max(cohort) + 1, 1)
  if('time' %in% colnames(base_df)) {
    time <- base_df$time
  } else {
    time <- rep(0, length(dose))
  }
  if(length(time) > 0) {
    time_now <- max(time)
  } else {
    time_now <- 0
  }

  i <- 1 # dose-decision counter
  max_i <- 30 # Maximum number of dose decisions to make; ignored if
              # i_like_big_trials = TRUE.
  fit <- selector_factory %>% fit(base_df)
  if(is.null(next_dose)) next_dose <- fit %>% recommended_dose()
  fits <- list()
  fits[[1]] <- list(.depth = i, time = time_now, fit = fit)
  while(fit %>% continue() & !is.na(next_dose) &
        (i_like_big_trials | i < max_i)) {

    current_data = data.frame(
      cohort = cohort,
      patient = seq_along(dose),
      dose = dose,
      tox = tox,
      time = time
    )
    new_pts <- sample_patient_arrivals(current_data)
    arrival_time_deltas <- cumsum(new_pts$time_delta)
    n_new_pts <- nrow(new_pts)
    new_dose <- rep(next_dose, n_new_pts)
    new_pt_indices <- nrow(current_data) + seq(1, n_new_pts)
    new_tox <- patient_sample$get_patient_tox(
      i = new_pt_indices,
      prob_tox = true_prob_tox[next_dose]
    )
    new_cohort <- rep(next_cohort, n_new_pts)

    dose <- c(dose, new_dose)
    tox <- c(tox, new_tox)
    cohort <- c(cohort, new_cohort)
    time <- c(time, time_now + arrival_time_deltas)
    new_data = data.frame(
      cohort = cohort,
      patient = 1:length(dose),
      dose = dose,
      tox = tox,
      time = time
    )

    time_now <- time_now + tail(arrival_time_deltas, 1)
    i <- i + 1
    fit <- selector_factory %>% fit(new_data)
    next_cohort <- next_cohort + 1
    fits[[i]] <- list(.depth = i, time = time_now, fit = fit)
    next_dose <- fit %>% recommended_dose()
  }

  # Warn about i_like_big_trials if sim stopped because of too big i.
  if(!i_like_big_trials & i >= max_i) {
    warning(paste(
      "Simulation stopped because max depth reached.",
      "Set 'i_like_big_trials = TRUE' to avoid this constraint. "))
  }

  if(return_all_fits) {
    return(fits)
  } else {
    return(tail(fits, 1))
  }
}