The hardware and bandwidth for this mirror is donated by METANET, the Webhosting and Full Service-Cloud Provider.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]metanet.ch.

Compare to publication

library(bfboin)

Consider the simulation scenarios from Table 3 of Zhao et al. (2024).

sim_scenario <- data.frame(Scenario = rep(1:12, each = 5),
                           Dose_level = paste0("Dose ", rep(1:5, 12)), 
                           DLT = c(0.25, 0.41, 0.45, 0.49, 0.53,
                                   0.12, 0.25, 0.42, 0.49, 0.55,
                                   0.04, 0.12, 0.25, 0.43, 0.63,
                                   0.02, 0.06, 0.1,  0.25, 0.4, 
                                   0.02, 0.05, 0.08, 0.11, 0.25,
                                   0.12, 0.25, 0.42, 0.49, 0.55, 
                                   0.04, 0.12, 0.25, 0.43, 0.63, 
                                   0.02, 0.06, 0.1,  0.25, 0.4, 
                                   0.02, 0.05, 0.08, 0.11, 0.25, 
                                   0.04, 0.12, 0.25, 0.43, 0.63, 
                                   0.02, 0.06, 0.1,  0.25, 0.4, 
                                   0.02, 0.05, 0.08, 0.11, 0.25),
                           Response = c(0.3,  0.4,  0.45, 0.5,  0.55, 
                                        0.2,  0.3,  0.4,  0.5,  0.6,
                                        0.1,  0.2,  0.3,  0.45, 0.58, 
                                        0.05, 0.1,  0.15, 0.3,  0.45,
                                        0.05, 0.1,  0.15, 0.2,  0.3,
                                        0.3,  0.35, 0.36, 0.36, 0.36,
                                        0.15, 0.3,  0.35, 0.36, 0.36,
                                        0.10, 0.2,  0.3,  0.35, 0.35,
                                        0.10, 0.15, 0.2,  0.3,  0.35, 
                                        0.3,  0.32, 0.35, 0.36, 0.36, 
                                        0.1,  0.3,  0.32, 0.35, 0.36, 
                                        0.1,  0.15, 0.3,  0.32, 0.35)) 

tab_scenario <- sim_scenario |>
  tidyr::pivot_longer(cols = c("DLT", "Response"),
               names_to = "Rate",
               values_to = "value") |>
  tidyr::pivot_wider(names_from = Dose_level,
              values_from = "value")


knitr::kable(tab_scenario, row.names = NA)
Scenario Rate Dose 1 Dose 2 Dose 3 Dose 4 Dose 5
1 DLT 0.25 0.41 0.45 0.49 0.53
1 Response 0.30 0.40 0.45 0.50 0.55
2 DLT 0.12 0.25 0.42 0.49 0.55
2 Response 0.20 0.30 0.40 0.50 0.60
3 DLT 0.04 0.12 0.25 0.43 0.63
3 Response 0.10 0.20 0.30 0.45 0.58
4 DLT 0.02 0.06 0.10 0.25 0.40
4 Response 0.05 0.10 0.15 0.30 0.45
5 DLT 0.02 0.05 0.08 0.11 0.25
5 Response 0.05 0.10 0.15 0.20 0.30
6 DLT 0.12 0.25 0.42 0.49 0.55
6 Response 0.30 0.35 0.36 0.36 0.36
7 DLT 0.04 0.12 0.25 0.43 0.63
7 Response 0.15 0.30 0.35 0.36 0.36
8 DLT 0.02 0.06 0.10 0.25 0.40
8 Response 0.10 0.20 0.30 0.35 0.35
9 DLT 0.02 0.05 0.08 0.11 0.25
9 Response 0.10 0.15 0.20 0.30 0.35
10 DLT 0.04 0.12 0.25 0.43 0.63
10 Response 0.30 0.32 0.35 0.36 0.36
11 DLT 0.02 0.06 0.10 0.25 0.40
11 Response 0.10 0.30 0.32 0.35 0.36
12 DLT 0.02 0.05 0.08 0.11 0.25
12 Response 0.10 0.15 0.30 0.32 0.35

In the following chunk of code we use get.oc.bf to calculate the operating characteristics of BF-BOIN under these scenarios. In this vignette we only simulate 1000 trials per scenario, and we only consider the first two scenarios.

generate_oc <- function(x, DLT_target = 0.25) {
  
  rate_dlt <- dplyr::filter(sim_scenario, Scenario == x)$DLT
  rate_response <- dplyr::filter(sim_scenario, Scenario == x)$Response 
  
  temp <- get.oc.bf(ntrial = 1000,
                    seed = 1000,
                    target = DLT_target,
                    p.true = rate_dlt,
                    ncohort = 10,
                    cohortsize = 3,
                    n.earlystop = 9,
                    startdose = 1,
                    titration = FALSE,
                    p.saf = 0.6 * DLT_target, 
                    p.tox = 1.4 * DLT_target,
                    cutoff.eli = 0.95,
                    extrasafe = FALSE, 
                    offset = 0.05,
                    boundMTD=FALSE,
                    n.cap = 12,
                    end.backfill = TRUE,
                    n.per.month = 3,
                    dlt.window = 1,
                    p.response.true = rate_response,
                    three.plus.three = FALSE,
                    accrual = "uniform")
  
  
  out <- data.frame(Dose_level        = paste0("Dose ", 1:5),
                    Toxicity_rate     = rate_dlt,
                    Response_rate     = rate_response, 
                    percent_selection = temp$selpercent,
                    n_patients        = temp$npatients,
                    percent_patients  = temp$percentpatients,
                    n_toxicity        = temp$ntox,
                    n_total           = temp$totaln,
                    percent_stop      = temp$percentstop,
                    duration          = temp$duration,
                    scenario          = x)
  
  return(out)
}

out_sim <- purrr::map_dfr(1:2, generate_oc)
head(out_sim)
#>       Dose_level Toxicity_rate Response_rate percent_selection n_patients
#> 1...1     Dose 1          0.25          0.30              79.9     11.179
#> 2...2     Dose 2          0.41          0.40              12.0      4.649
#> 3...3     Dose 3          0.45          0.45               0.6      0.685
#> 4...4     Dose 4          0.49          0.50               0.0      0.036
#> 5...5     Dose 5          0.53          0.55               0.0      0.003
#> 1...6     Dose 1          0.12          0.20              29.9     11.399
#>       percent_patients n_toxicity n_total percent_stop  duration scenario
#> 1...1       67.5386660      2.774  16.552          7.5  8.325489        1
#> 2...2       28.0872402      1.919  16.552          7.5  8.325489        1
#> 3...3        4.1384727      0.319  16.552          7.5  8.325489        1
#> 4...4        0.2174964      0.019  16.552          7.5  8.325489        1
#> 5...5        0.0181247      0.002  16.552          7.5  8.325489        1
#> 1...6       44.3023708      1.288  25.730          0.6 12.507645        2

Next we post-process this output to match the format of Table 4 of the paper.

out_OC <- out_sim |>
  dplyr::group_by(scenario, n_total, duration) |>
  dplyr::summarise(`Correct selection (%)`     = round(sum(percent_selection[Toxicity_rate == 0.25]), 1),
                   `Over-dosing selection (%)` = round(sum(percent_selection[Toxicity_rate > 0.25]), 1),
                   `Patients below MTD, n`     = sum(n_patients[Toxicity_rate < 0.25]),
                   `Patients below MTD, %`     = sum(percent_patients[Toxicity_rate < 0.25]),
                   `Patients at MTD, n`        = sum(n_patients[Toxicity_rate == 0.25]),
                   `Patients at MTD, %`        = sum(percent_patients[Toxicity_rate == 0.25]),
                   `Patients over-dosed, n`    = sum(n_patients[Toxicity_rate > 0.25]),
                   `Patients over-dosed, %`    = sum(percent_patients[Toxicity_rate > 0.25])) |>
  dplyr::mutate(`Patients below MTD, n (%)`    = paste0(round(`Patients below MTD, n`, 1),
                                                        " (", round(`Patients below MTD, %`, 1), ")"),
                `Patients at MTD, n (%)`       = paste0(round(`Patients at MTD, n`, 1), 
                                                        " (", round(`Patients at MTD, %`, 1), ")"),
                `Patients over-dosed, n (%)`   = paste0(round(`Patients over-dosed, n`, 1), 
                                                        " (", round(`Patients over-dosed, %`, 1), ")"),
                `Average sample size (n)`      = round(n_total, 1),
                `Average duration (months)`    = round(duration, 1)) |>
  dplyr::ungroup() |>
  dplyr::select(scenario, `Correct selection (%)`, `Over-dosing selection (%)`,
                `Patients below MTD, n (%)`, `Patients at MTD, n (%)`, 
                `Patients over-dosed, n (%)`, `Average sample size (n)`,
                `Average duration (months)`)
#> `summarise()` has grouped output by 'scenario', 'n_total'. You can override
#> using the `.groups` argument.


knitr::kable(out_OC)
scenario Correct selection (%) Over-dosing selection (%) Patients below MTD, n (%) Patients at MTD, n (%) Patients over-dosed, n (%) Average sample size (n) Average duration (months)
1 79.9 12.6 0 (0) 11.2 (67.5) 5.4 (32.5) 16.6 8.3
2 59.9 9.6 11.4 (44.3) 10.3 (39.9) 4.1 (15.8) 25.7 12.5

And confirm that this matches (up to simulation error):

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.