## ----SETTINGS-knitr, include=FALSE--------------------------------------------
## knitr settings used to build vignettes
library(OncoBayes2)
library(posterior)
library(RBesT)
library(dplyr)
library(tidyr)
library(knitr)
library(ggplot2)
ggplot2::theme_set(bayesplot::bayesplot_theme_get())
knitr::knit_hooks$set(pngquant = knitr::hook_pngquant)
knitr::opts_chunk$set(
  dev = "ragg_png",
  dpi = 72,
  fig.retina = 1.5,
  fig.width = 1.62*4,
  fig.height = 4,
  fig.align = "center",
  out.width = "100%",
  pngquant = "--speed=1 --quality=50"
  )

## ----SETTINGS-sampling, include=FALSE-----------------------------------------
## sampling settings used to build vignettes
## setup up fast sampling when run on CRAN
not_CRAN <- Sys.getenv("NOT_CRAN", "false") == "true" 
## NOTE: for running this vignette locally, please uncomment the
## following line:
## not_CRAN <- TRUE
.user_mc_options <- list()

if (!not_CRAN) {
    .user_mc_options <- options(OncoBayes2.MC.warmup=40, OncoBayes2.MC.iter=100, OncoBayes2.MC.chains=1, OncoBayes2.MC.save_warmup=FALSE, OncoBayes2.MC.control = list(adapt_delta=0.85), mc.cores=1)
} else {
    .user_mc_options <- options(OncoBayes2.MC.warmup=500, OncoBayes2.MC.iter=1000, OncoBayes2.MC.chains=4, OncoBayes2.MC.save_warmup=FALSE, OncoBayes2.MC.control = list(adapt_delta=0.99), mc.cores=1)
}
set.seed(6475863)

## ----message = FALSE----------------------------------------------------------
## Load involved packages
library(RBesT)   ## used to define priors
library(dplyr)   ## for mutate
library(tidyr)   ## defines expand_grid
library(tibble)  ## for tibbles
library(ggplot2) ## for plotting

## -----------------------------------------------------------------------------
kable(hist_combo2)

## ----echo=TRUE----------------------------------------------------------------
levels(hist_combo2$group_id)

## -----------------------------------------------------------------------------
kable(drug_info_combo2)

## -----------------------------------------------------------------------------
dose_info <- filter(
  dose_info_combo2, group_id == "trial_AB",
  drug_A %in% c(3, 6), drug_B %in% c(0, 400, 800)
)
kable(dose_info)

## -----------------------------------------------------------------------------
combo2_trial_setup <- blrm_trial(
  data = hist_combo2,
  drug_info = drug_info_combo2,
  dose_info = dose_info
)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
combo2_trial_start <- blrm_trial(
  data = hist_combo2,
  drug_info = drug_info_combo2,
  dose_info = dose_info,
  simplified_prior = TRUE,
  EXNEX_comp = FALSE,
  EX_prob_comp_hist = 1,
  EX_prob_comp_new = 1
)

## ----eval = FALSE-------------------------------------------------------------
#  prior_summary(combo2_trial_start) # not run here

## -----------------------------------------------------------------------------
kable(summary(combo2_trial_start, "dose_prediction"), digits = 2)

## -----------------------------------------------------------------------------
kable(summary(combo2_trial_start, "ewoc_check"), digits = 3)

## ----include=FALSE------------------------------------------------------------
po <- summary(combo2_trial_start, "ewoc_check")$prob_overdose_stat
min_stat <- po[which.min(abs(po))]

## -----------------------------------------------------------------------------
candidate_starting_dose <- summary(combo2_trial_start, "dose_info") |>
  filter(drug_A == 3, drug_B == 400) |>
  crossing(num_toxicities = 0, num_patients = 3:6)

pp_summary <- summary(combo2_trial_start,
  interval_prob = c(-1, 0, 1, 6), predictive = TRUE,
  newdata = candidate_starting_dose
)

kable(bind_cols(
  select(candidate_starting_dose, num_patients),
  select(pp_summary, ends_with("]"))
), digits = 3)

## -----------------------------------------------------------------------------
new_cohort <- tibble(
  group_id = "trial_AB",
  drug_A = 3,
  drug_B = 400,
  num_patients = 5,
  num_toxicities = 1
)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
combo2_trial_update <- update(combo2_trial_start, add_data = new_cohort)

## -----------------------------------------------------------------------------
kable(summary(combo2_trial_update, "dose_prediction"), digits = 2)

## -----------------------------------------------------------------------------
kable(summary(combo2_trial_update, "newdata_prediction",
  newdata = tibble(
    group_id = "trial_AB",
    drug_A = 4.5,
    drug_B = c(400, 600, 800)
  )
), digits = 2)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
# set up two scenarios at the starting dose level
# store them as data frames in a named list
scenarios <- expand_grid(
  group_id = "trial_AB",
  drug_A = 3,
  drug_B = 800,
  num_patients = 3,
  num_toxicities = 0:2
) |>
  split(1:3) |>
  setNames(paste0(0:2, "/3 DLTs"))

candidate_doses <- expand_grid(
  group_id = "trial_AB",
  drug_A = c(3, 4.5),
  drug_B = c(600, 800)
)

scenario_inference <- lapply(scenarios, function(scenario_newdata) {
  # refit the model with each scenario's additional data
  scenario_fit <- update(combo2_trial_update, add_data = scenario_newdata)
  # summarize posterior at candidate doses
  summary(scenario_fit, "newdata_prediction", newdata = candidate_doses)
}) |>
  bind_rows(.id = "Scenario")

## ----echo = FALSE-------------------------------------------------------------
kable(select(scenario_inference, -group_id, -stratum_id, -dose_id),
  digits = 2,
  caption = "Model inference for trial AB when varying hypothetical DLT scenarios for a cohort of size 3"
)

## -----------------------------------------------------------------------------
trial_AB_data <- filter(codata_combo2, group_id == "trial_AB", cohort_time == 1)
kable(trial_AB_data)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
combo2_trial_histdata <- update(combo2_trial_start, add_data = trial_AB_data)

## -----------------------------------------------------------------------------
trial_A_codata <- filter(codata_combo2, group_id == "trial_A", cohort_time == 1)
kable(trial_A_codata)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
combo2_trial_codata <- update(combo2_trial_histdata, add_data = trial_A_codata)

## ----fig.height = 1.2 * 4, fig.width=1.62 * 4---------------------------------
plot_toxicity_intervals_stacked(combo2_trial_histdata,
  newdata = mutate(dose_info, dose_id = NULL, stratum_id = "all"),
  x = vars(drug_B),
  group = vars(drug_A),
  facet_args = list(ncol = 1)
) + ggtitle("Trial AB with historical data only")

plot_toxicity_intervals_stacked(combo2_trial_codata,
  newdata = mutate(dose_info, dose_id = NULL, stratum_id = "all"),
  x = vars(drug_B),
  group = vars(drug_A),
  facet_args = list(ncol = 1)
) + ggtitle("Trial AB with historical and concurrent data on drug A")

## -----------------------------------------------------------------------------
trial_AB_stage_2_codata <- filter(codata_combo2, cohort_time == 2)
kable(trial_AB_stage_2_codata)

## ----message = FALSE, echo = TRUE, results = "hide"---------------------------
combo2_trial_final <- update(combo2_trial_start, data = codata_combo2)

## ----fig.height = 1.05 * 4, fig.width=1.62 * 4--------------------------------
grid_length <- 25

dose_info_plot_grid <- expand_grid(
  stratum_id = "all",
  group_id = "trial_AB",
  drug_A = seq(min(dose_info_combo2$drug_A),
               max(dose_info_combo2$drug_A),
               length.out = grid_length),
  drug_B = seq(min(dose_info_combo2$drug_B),
               max(dose_info_combo2$drug_B),
               length.out = grid_length)
)


dose_info_plot_grid_sum <- summary(combo2_trial_final,
  newdata = dose_info_plot_grid,
  prob = 0.5
)

ggplot(dose_info_plot_grid_sum, aes(drug_A, drug_B, z = !!as.name("75%"))) +
  geom_contour_filled(breaks = c(0, 0.1, 0.16, 0.33, 1)) +
  scale_fill_brewer("Quantile Range", type = "div", palette = "RdBu", direction = -1) +
  ggtitle("DLT Probability 75% Quantile")

## -----------------------------------------------------------------------------
sessionInfo()

## ----include=FALSE------------------------------------------------------------
## restore previous global user options
options(.user_mc_options)