
An Example of Simulating a Trial with Adaptive Design
Source:vignettes/adaptiveDesign.Rmd
adaptiveDesign.Rmd
In this vignette, we illustrate how to use
TrialSimulator
to simulate a trial with seamless adaptive
design of multiple endpoints, where dose selection, futility analysis,
interim analysis are triggered by user-defined milestones. Family-wise
error rate are controlled by closed test with Dunnett’s test, with
split for the endpoints. Please refer to another vignette where
graphical testing procedure is adopted instead.
Simulation Settings
- Trial consists of two active arms of high or low dose, and a placebo arm.
- Patients are randomized into the trial with ratio
1:1:1
. - 30 patients are randomized per month for the first 10 months, and 50 patients per month after then until 1000 patients.
- Dropout rate is 8% at month 12, and 18% at month 18, which is modeled by a Weibull distribution. The scale and shape parameters of the Weibull distribution can be computed using helper function
weibullDropout(time = c(12, 18), dropout_rate = c(.08, .18))
#> shape scale
#> 2.138567 38.343517
- Two time-to-event endpoints (
PFS
andOS
) and a binarysurrogate
are under consideration, where a higher rate ofsurrogate
is better. -
surrogate
has a readout time of 5 weeks. -
surrogate
is used for dose selection using a hypothetical rule. Let (or ) be the z statistics ofsurrogate
between high (or low) dose and placebo.- low dose arm is selected if ;
- high dose arm is selected if ;
- keep both arms otherwise.
- Rates of
surrogate
are- 0.05 in placebo
- 0.12 in low dose arm
- 0.13 in high dose arm
- Medians of PFS are
- 5 months in placebo
- 6.7 months in low dose arm (hazard ratio 0.75)
- 7.1 months in high dose arm (hazard ratio 0.70) Exponential distribution is assumed.
- Medians of OS are
- 14 months in placebo
- 17.5 months in low dose arm (hazard ratio 0.80)
- 18.2 months high dose arms (hazard ratio 0.77)
- Dose selection is done when 300 patients are randomized with readout
of
surrogate
are ready for analysis. - An interim is set to test
PFS
when 300PFS
events are observed. A non-binding futility analysis is also done with a boundary 0.5. - Final analysis is set for
PFS
andOS
when all planned 1000 patients are randomized and at least 300OS
events are observed. Meanwhile, the trial has reached at least 28 months or at least 520 events are observed forPFS
. - To control the family-wise error rate accounting for
PFS
andOS
, as well as adaptation of dose-selection, we split betweenPFS
(0.5%) andOS
(2%), and adopt closed test with Dunnett’s test for intersection hypotheses.
Define Three Arms
#' define three arms
pbo <- arm(name = 'placebo')
low <- arm(name = 'low dose')
high <- arm(name = 'high dose')
#' define endpoints in placebo
pfs <- endpoint(name = 'pfs', type = 'tte',
generator = rexp, rate = log(2) / 5)
os <- endpoint(name = 'os', type = 'tte',
generator = rexp, rate = log(2) / 14)
five_weeks <- 5 / 52 * 12 ## convert it in months
surrogate <- endpoint(name = 'surrogate', type = 'non-tte',
readout = c(surrogate = five_weeks),
generator = rbinom, size = 1, prob = .05)
pbo$add_endpoints(pfs, os, surrogate)
#' define endpoints in low dose arm
pfs <- endpoint(name = 'pfs', type = 'tte',
generator = rexp, rate = log(2) / 6.7)
os <- endpoint(name = 'os', type = 'tte',
generator = rexp, rate = log(2) / 17.5)
surrogate <- endpoint(name = 'surrogate', type = 'non-tte',
readout = c(surrogate = five_weeks),
generator = rbinom, size = 1, prob = .12)
low$add_endpoints(pfs, os, surrogate)
#' define endpoints in high dose arm
pfs <- endpoint(name = 'pfs', type = 'tte',
generator = rexp, rate = log(2) / 7.1)
os <- endpoint(name = 'os', type = 'tte',
generator = rexp, rate = log(2) / 18.2)
surrogate <- endpoint(name = 'surrogate', type = 'non-tte',
readout = c(surrogate = five_weeks),
generator = rbinom, size = 1, prob = .13)
high$add_endpoints(pfs, os, surrogate)
Define a Trial
With three arms, we can define a trial of class Trial
.
Recruitment curve are specified through enroller
with a
built-in function StaggeredRecruiter
of piecewise constant
rate. We set duration
to be an arbitrary large number (50)
but controlling the end of trial through pre-defined milestones later.
Note that if seed = NULL
, TrialSimulator
will
pick a seed for the purpose of reproducibility.
accrual_rate <- data.frame(end_time = c(10, Inf),
piecewise_rate = c(30, 50))
trial <- trial(
name = 'Trial-3415', n_patients = 1000,
seed = 1727811904, duration = 40,
enroller = StaggeredRecruiter, accrual_rate = accrual_rate,
dropout = rweibull, shape = 2.139, scale = 38.343
)
trial$add_arms(sample_ratio = c(1, 1, 1), low, high, pbo)
#> Arm(s) <low dose, high dose, placebo> are added to the trial.
#> Randomization is done for 1000 potential patients.
#> Data of 1000 potential patients are generated for the trial with 3 arm(s) <low dose, high dose, placebo>.
Define Trial Milestones and Action Functions
Next, we define action functions for trial milestones, i.e., dose
selection, interim and final analysis. Note that an action function
should always has arguments trial
of class
Trial
and a character milestone_name
. We
calculate z statistics of the Farrington-Manning test for binary
endpoint surrogate
using helper function
fitFarringtonManning
, which returns a data frame (see
?fitFarringtonManning
).
action1 <- function(trial, milestone_name){
locked_data <- trial$get_locked_data(milestone_name)
fit <- fitFarringtonManning(endpoint = 'surrogate', placebo = 'placebo',
data = locked_data, alternative = 'greater')
# browser() ## if you want to see what does fit look like
z_l <- fit$z[fit$arm == 'low dose']
z_h <- fit$z[fit$arm == 'high dose']
if(z_l > 1.28){
trial$remove_arms('high dose')
trial$save(value = 'low', name = 'kept_arm')
}else if(z_h > 1.28){
trial$remove_arms('low dose')
trial$save(value = 'high', name = 'kept_arm')
}else{
trial$save(value = 'both', name = 'kept_arm')
}
invisible(NULL)
}
At the interim, we test PFS
using the logrank test to
carry out a non-binding futility analysis in the following action
function. Depending on how many arms are carried forward in dose
selection, fit
may consists of testing results of one or
two dose arms. Note that a formal test for PFS
will be done
at the end of the trial when we have all p-values. If no futility
analysis is planned, we can simply set action = doNothing
in milestone
.
action2 <- function(trial, milestone_name){
locked_data <- trial$get_locked_data(milestone_name)
fit <- fitLogrank(endpoint = 'pfs', placebo = 'placebo',
data = locked_data)
## futility analysis
if(max(fit$z) < .5){
trial$save(value = 'negative', name = 'futility')
## extend duration
## trial$set_duration(45)
}else{
trial$save(value = 'positive', name = 'futility')
}
invisible(NULL)
}
At final analysis, we conduct a closed test using Dunnett’s test for intersection hypotheses. The action function is as follows.
action3 <- function(trial, milestone_name){
locked_data <- trial$get_locked_data(milestone_name)
## test PFS
dt_pfs <- trial$dunnettTest(endpoint = 'pfs', placebo = 'placebo',
treatments = c('high dose', 'low dose'),
milestones = c('dose selection', 'interim', 'final'),
planned_info = 'default')
ct_pfs <- trial$closedTest(dt_pfs, treatments = c('high dose', 'low dose'),
milestones = c('interim', 'final'),
alpha = .005, alpha_spending = 'asOF')
## test OS
dt_os <- trial$dunnettTest(endpoint = 'os', placebo = 'placebo',
treatments = c('high dose', 'low dose'),
milestones = c('dose selection', 'final'),
planned_info = 'default')
ct_os <- trial$closedTest(dt_pfs, treatments = c('high dose', 'low dose'),
milestones = c('final'),
alpha = .02, alpha_spending = 'asOF')
## we only save testing decision here
## You can save whatever you want for summarizing things later, e.g. reject time
trial$save(value = ct_pfs$decision[ct_pfs$arm == 'high dose'],
name = 'pfs_high_dose_decision')
trial$save(value = ct_pfs$decision[ct_pfs$arm == 'low dose'],
name = 'pfs_low_dose_decision')
trial$save(value = ct_os$decision[ct_os$arm == 'high dose'],
name = 'os_high_dose_decision')
trial$save(value = ct_os$decision[ct_os$arm == 'low dose'],
name = 'os_low_dose_decision')
invisible(NULL)
}
Next, we register three trial milestones to a listener
dose_selection <- milestone(name = 'dose selection', action = action1,
trigger_condition =
eventNumber(endpoint = 'surrogate', n = 300)
)
interim <- milestone(name = 'interim', action = action2,
trigger_condition =
eventNumber(endpoint = 'pfs', n = 300)
)
final <- milestone(name = 'final', action = action3,
trigger_condition =
enrollment(n = 1000, arms = c('placebo', 'low dose', 'high dose')) &
eventNumber(endpoint = 'os', n = 300) & (
calendarTime(time = 28) |
eventNumber(endpoint = 'pfs', n = 520)
)
)
listener <- listener()
#' register milestones with listener
listener$add_milestones(
dose_selection,
interim,
final
)
#> A milestone <dose selection> is registered.
#> A milestone <interim> is registered.
#> A milestone <final> is registered.
Execute a Trial
We can run a trial as follows. By default,
TrialSimulator
generates a plot showing cumulative number
of patients or endpoint events over time for each of the arms. We can
set it to FALSE
if a massive number of simulation
replicates is run to save time.
controller <- controller(trial, listener)
controller$run(plot_event = TRUE)
#> Conditioin of milestone <dose selection> is being checked.
#> Data is locked at time = 11.3138461538462 for milestone <dose selection>.
#> Locked data can be accessed in Trial$get_locked_data('dose selection').
#> Number of events at lock time:
#> patient pfs os surrogate arms
#> 1 366 142 65 300 <low dose, high dose, placebo>
#>
#> Arm <high dose> is removed.
#> Sample ratio is updated to be <low dose: 1, placebo: 1>.
#> Trial data is rolling back to time = 11.3138461538462.
#> Randomization will be carried out again for unenrolled patients.
#> Randomization is done for 634 potential patients.
#> Data of 634 potential patients are generated for the trial with 2 arm(s) <low dose, placebo>.
#> Conditioin of milestone <interim> is being checked.
#> Data is locked at time = 19.1658431016631 for milestone <interim>.
#> Locked data can be accessed in Trial$get_locked_data('interim').
#> Number of events at lock time:
#> patient pfs os surrogate arms
#> 1 637 300 146 534 <low dose, placebo>
#>
#> Conditioin of milestone <final> is being checked.
#> Data is locked at time = 29.4476342734663 for milestone <final>.
#> Locked data can be accessed in Trial$get_locked_data('final').
#> Number of events at lock time:
#> patient pfs os surrogate arms
#> 1 878 542 300 744 <low dose, placebo>
#>
In custom action functions, we can use Trial$save()
to
save intermediate results for summary purpose, which can be accessed
anytime and anywhere by
controller$get_output() %>%
kable(escape = FALSE) %>%
kable_styling(bootstrap_options = "striped",
full_width = FALSE,
position = "left") %>%
scroll_box(width = "100%")
trial | seed | milestone_time_<dose selection> | n_events_<dose selection>_<patient_id> | n_events_<dose selection>_<pfs> | n_events_<dose selection>_<os> | n_events_<dose selection>_<surrogate> | n_events_<dose selection>_<arms> | kept_arm | milestone_time_<interim> | n_events_<interim>_<patient_id> | n_events_<interim>_<pfs> | n_events_<interim>_<os> | n_events_<interim>_<surrogate> | n_events_<interim>_<arms> | futility | milestone_time_<final> | n_events_<final>_<patient_id> | n_events_<final>_<pfs> | n_events_<final>_<os> | n_events_<final>_<surrogate> | n_events_<final>_<arms> | pfs_high_dose_decision | pfs_low_dose_decision | os_high_dose_decision | os_low_dose_decision | error_message |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Trial-3415 | 1727811904 | 11.31385 | 366 | 142 | 65 | 300 | <low dose, high dose, placebo> | low | 19.16584 | 637 | 300 | 146 | 534 | <low dose, placebo> | positive | 29.44763 | 878 | 542 | 300 | 744 | <low dose, placebo> | accept | reject | accept | reject |
Here we dive into the action function (action3
) for the
final analysis. We can literally execute the function line by line with
locked data loaded. Note that the member functions
Trial$dunnettTest
and Trial$closedTest
can
make use of locked data at multiple stages (through the
milestones
argument) automatically, thus, unlike in
action3
, an explicit call of
Trial$get_locked_data(milestone_name)
is unnecessary.
## test PFS
dt_pfs <- trial$dunnettTest(endpoint = 'pfs', placebo = 'placebo',
treatments = c('high dose', 'low dose'),
milestones = c('dose selection', 'interim', 'final'),
planned_info = 'default')
ct_pfs <- trial$closedTest(dt_pfs, treatments = c('high dose', 'low dose'),
milestones = c('interim', 'final'),
alpha = .005, alpha_spending = 'asOF')
## test OS
dt_os <- trial$dunnettTest(endpoint = 'os', placebo = 'placebo',
treatments = c('high dose', 'low dose'),
milestones = c('dose selection', 'final'),
planned_info = 'default')
ct_os <- trial$closedTest(dt_pfs, treatments = c('high dose', 'low dose'),
milestones = c('final'),
alpha = .02, alpha_spending = 'asOF')
print(ct_pfs)
#> arm decision milestone_at_reject reject_time
#> 1 high dose accept <NA> Inf
#> 2 low dose reject final 29.44763
print(ct_os)
#> arm decision milestone_at_reject reject_time
#> 1 high dose accept <NA> Inf
#> 2 low dose reject final 29.44763
The two null hypotheses of PFS
and OS
are
both accepted for the high dose because it is dropped at dose selection.
Thus, milestone_at_reject
is NA
, and the
reject_time
is infinite. In contrast, PFS
and
OS
are significant in low does. Note that even if
PFS
are tested at interim and final, one cannot claim its
significance until the final analysis
(milestone_at_reject
). The reject_time
(29.4476343) can be saved to the output using the member function
Trial$save
.
TrialSimulator
abstracts the data generation and
management to allow user focus on implementing the statistical analysis.
It simulates a trial on patient level, and provide flexibility in
adaptive design.
Execute Trial Simulation
We can run a massive number of replicates in simulation to study
operating characteristics of a trial design by specifying n
in Controller$run()
. We can set
plot_event = FALSE
to turn off plotting to save running
time.
## reset a controller if $run has been executed before
controller$reset()
controller$run(n = 1000, plot_event = FALSE, silent = TRUE)
output <- controller$get_output()
output %>%
head(10) %>%
kable(escape = FALSE) %>%
kable_styling(bootstrap_options = "striped",
full_width = FALSE,
position = "left") %>%
scroll_box(width = "100%")
trial | seed | milestone_time_<dose selection> | n_events_<dose selection>_<patient_id> | n_events_<dose selection>_<pfs> | n_events_<dose selection>_<os> | n_events_<dose selection>_<surrogate> | n_events_<dose selection>_<arms> | kept_arm | milestone_time_<interim> | n_events_<interim>_<patient_id> | n_events_<interim>_<pfs> | n_events_<interim>_<os> | n_events_<interim>_<surrogate> | n_events_<interim>_<arms> | futility | milestone_time_<final> | n_events_<final>_<patient_id> | n_events_<final>_<pfs> | n_events_<final>_<os> | n_events_<final>_<surrogate> | n_events_<final>_<arms> | pfs_high_dose_decision | pfs_low_dose_decision | os_high_dose_decision | os_low_dose_decision | error_message |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Trial-3415 | 1727811904 | 11.31385 | 366 | 142 | 65 | 300 | <low dose, high dose, placebo> | low | 19.16584 | 637 | 300 | 146 | 534 | <low dose, placebo> | positive | 29.44763 | 878 | 542 | 300 | 744 | <low dose, placebo> | accept | reject | accept | reject |
output %>%
summarise(
time_dose_selection = mean(`milestone_time_<dose selection>`),
time_interim = mean(`milestone_time_<interim>`),
time_final = mean(`milestone_time_<final>`),
n_dose_selection = mean(`n_events_<dose selection>_<patient_id>`),
n_interim = mean(`n_events_<interim>_<patient_id>`),
n_final = mean(`n_events_<final>_<patient_id>`),
low = mean(kept_arm == 'low') * 100,
high = mean(kept_arm == 'high') * 100,
both = mean(kept_arm == 'both') * 100
) %>%
kable(col.names = NULL, digits = 1, align = 'r',
caption = 'Number of Randomized Patients at Stages') %>%
add_header_above(c(rep(c('Dose Selection', 'Interim', 'Final'), 2),
'Low Dose', 'High Dose', 'Both'), align = 'r') %>%
add_header_above(c('Time' = 3, 'Number of Patients' = 3, 'Selected Dose (%)' = 3)) %>%
kable_styling(full_width = TRUE)
11.3 | 19.2 | 29.4 | 366 | 637 | 878 | 100 | 0 | 0 |
output %>%
summarise(
n_pfs_dose_selection = mean(`n_events_<dose selection>_<pfs>`),
n_pfs_interim = mean(`n_events_<interim>_<pfs>`),
n_pfs_final = mean(`n_events_<final>_<pfs>`),
n_os_dose_selection = mean(`n_events_<dose selection>_<os>`),
n_os_interim = mean(`n_events_<interim>_<os>`),
n_os_final = mean(`n_events_<final>_<os>`)
) %>%
kable(col.names = NULL, digits = 1, align = 'r',
caption = 'Number of Events of PFS and OS at Stages') %>%
add_header_above(rep(c('Dose Selection', 'Interim', 'Final'), 2), align = 'r') %>%
add_header_above(c('PFS' = 3, 'OS' = 3)) %>%
kable_styling(full_width = TRUE)
142 | 300 | 542 | 65 | 146 | 300 |
output %>%
summarise(
power_pfs_low = mean(pfs_low_dose_decision == 'reject') * 100,
power_pfs_high = mean(pfs_high_dose_decision == 'reject') * 100,
power_pfs_or = mean(pfs_low_dose_decision == 'reject' | pfs_high_dose_decision == 'reject') * 100,
power_pfs_and = mean(pfs_low_dose_decision == 'reject' & pfs_high_dose_decision == 'reject') * 100,
power_os_low = mean(os_low_dose_decision == 'reject') * 100,
power_os_high = mean(os_high_dose_decision == 'reject') * 100,
power_os_or = mean(os_low_dose_decision == 'reject' | os_high_dose_decision == 'reject') * 100,
power_os_and = mean(os_low_dose_decision == 'reject' & os_high_dose_decision == 'reject') * 100
) %>%
kable(col.names = NULL, digits = 1, align = 'r',
caption = 'Power of Testing PFS and OS') %>%
add_header_above(rep(c('Low Dose', 'High Dose', 'Low or High', 'Low and High'), 2), align = 'r') %>%
add_header_above(c('PFS (%)' = 4, 'OS (%)' = 4)) %>%
kable_styling(full_width = TRUE)
100 | 0 | 100 | 0 | 100 | 0 | 100 | 0 |
output %>%
summarise(
power_pfs_not_os = mean((pfs_low_dose_decision == 'reject' | pfs_high_dose_decision == 'reject') &
os_low_dose_decision == 'accept' & os_high_dose_decision == 'accept') * 100,
power_os_not_pfs = mean((os_low_dose_decision == 'reject' | os_high_dose_decision == 'reject') &
pfs_low_dose_decision == 'accept' & pfs_high_dose_decision == 'accept') * 100,
power_pfs_and_os = mean((pfs_low_dose_decision == 'reject' | pfs_high_dose_decision == 'reject') &
(os_low_dose_decision == 'reject' | os_high_dose_decision == 'reject')) * 100,
power_pfs_or_os = mean((pfs_low_dose_decision == 'reject' | pfs_high_dose_decision == 'reject') |
(os_low_dose_decision == 'reject' | os_high_dose_decision == 'reject')) * 100
) %>%
kable(col.names = NULL, digits = 1, align = 'r',
caption = 'Power of Testing PFS and OS (Cont.)') %>%
add_header_above(c('Reject PFS and Accept OS', 'Accept PFS and Reject OS',
'Reject PFS and OS', 'Reject PFS or OS'), align = 'r') %>%
kable_styling(full_width = TRUE)
0 | 0 | 100 | 100 |