Skip to content

Commit 531381b

Browse files
authored
Merge pull request #499 from Merck/498-allow-event-table-as-input-of-gs_update_ahr
Allow `event_tbl` as input of `gs_update_ahr`
2 parents 0ee27bc + e112262 commit 531381b

File tree

5 files changed

+120
-353
lines changed

5 files changed

+120
-353
lines changed

DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: gsDesign2
22
Title: Group Sequential Design with Non-Constant Effect
3-
Version: 1.1.3
3+
Version: 1.1.3.1
44
Authors@R: c(
55
person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
66
person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")),

R/gs_update_ahr.R

Lines changed: 57 additions & 175 deletions
Original file line numberDiff line numberDiff line change
@@ -25,10 +25,18 @@
2525
#' with the spending time at each analysis.
2626
#' @param lstime Default is NULL in which case lower bound spending time is determined by timing.
2727
#' Otherwise, this should be a vector of length k (total number of analyses)
28-
#' with the spending time at each analysis
29-
#' @param observed_data a list of observed datasets by analyses.
28+
#' with the spending time at each analysis.
29+
#' @param event_tbl A data frame with two columns: (1) analysis and (2) event,
30+
#' which represents the events observed at each analysis per piecewise interval.
31+
#' This can be defined via the `pw_observed_event()` function or manually entered.
32+
#' For example, consider a scenario with two intervals in the piecewise model:
33+
#' the first interval lasts 6 months with a hazard ratio (HR) of 1,
34+
#' and the second interval follows with an HR of 0.6.
35+
#' The data frame `event_tbl = data.frame(analysis = c(1, 1, 2, 2), event = c(30, 100, 30, 200))`
36+
#' indicates that 30 events were observed during the delayed effect period,
37+
#' 130 events were observed at the IA, and 230 events were observed at the FA.
3038
#'
31-
#' @return A list with input parameters, enrollment rate, analysis, and bound.
39+
#' @return A list with input parameters, enrollment rate, failure rate, analysis, and bound.
3240
#'
3341
#' @export
3442
#'
@@ -58,85 +66,7 @@
5866
#' ratio <- 1
5967
#'
6068
#' # ------------------------------------------------- #
61-
#' # Example A: one-sided design (efficacy only)
62-
#' # ------------------------------------------------- #
63-
#' # Original design
64-
#' upper <- gs_spending_bound
65-
#' upar <- list(sf = sfLDOF, total_spend = alpha)
66-
#' x <- gs_design_ahr(
67-
#' enroll_rate = enroll_rate, fail_rate = fail_rate,
68-
#' alpha = alpha, beta = beta, ratio = ratio,
69-
#' info_scale = "h0_info",
70-
#' info_frac = NULL,
71-
#' analysis_time = c(20, 36),
72-
#' upper = gs_spending_bound, upar = upar,
73-
#' lower = gs_b, lpar = rep(-Inf, 2),
74-
#' test_upper = TRUE, test_lower = FALSE) |> to_integer()
75-
#'
76-
#' # Observed dataset at IA and FA
77-
#' set.seed(123)
78-
#'
79-
#' observed_data <- simtrial::sim_pw_surv(
80-
#' n = x$analysis$n[x$analysis$analysis == 2],
81-
#' stratum = data.frame(stratum = "All", p = 1),
82-
#' block = c(rep("control", 2), rep("experimental", 2)),
83-
#' enroll_rate = x$enroll_rate,
84-
#' fail_rate = (fail_rate |> simtrial::to_sim_pw_surv())$fail_rate,
85-
#' dropout_rate = (fail_rate |> simtrial::to_sim_pw_surv())$dropout_rate)
86-
#'
87-
#' observed_data_ia <- observed_data |> simtrial::cut_data_by_date(x$analysis$time[1])
88-
#' observed_data_fa <- observed_data |> simtrial::cut_data_by_date(x$analysis$time[2])
89-
#'
90-
#' observed_event_ia <- sum(observed_data_ia$event)
91-
#' observed_event_fa <- sum(observed_data_fa$event)
92-
#'
93-
#' planned_event_ia <- x$analysis$event[1]
94-
#' planned_event_fa <- x$analysis$event[2]
95-
#'
96-
#' # Example A1 ----
97-
#' # IA spending = observed events / final planned events
98-
#' # the remaining alpha will be allocated to FA.
99-
#' ustime <- c(observed_event_ia / planned_event_fa, 1)
100-
#' gs_update_ahr(
101-
#' x = x,
102-
#' ustime = ustime,
103-
#' observed_data = list(observed_data_ia, observed_data_fa))
104-
#'
105-
#' # Example A2 ----
106-
#' # IA, FA spending = observed events / final planned events
107-
#' ustime <- c(observed_event_ia, observed_event_fa) / planned_event_fa
108-
#' gs_update_ahr(
109-
#' x = x,
110-
#' ustime = ustime,
111-
#' observed_data = list(observed_data_ia, observed_data_fa))
112-
#'
113-
#' # Example A3 ----
114-
#' # IA spending = min(observed events, planned events) / final planned events
115-
# # the remaining alpha will be allocated to FA.
116-
#' ustime <- c(min(observed_event_ia, planned_event_ia) / planned_event_fa, 1)
117-
#' gs_update_ahr(
118-
#' x = x,
119-
#' ustime = ustime,
120-
#' observed_data = list(observed_data_ia, observed_data_fa))
121-
#'
122-
#' # Example A4 ----
123-
#' # IA spending = min(observed events, planned events) / final planned events
124-
#' ustime <- c(min(observed_event_ia, planned_event_ia),
125-
#' min(observed_event_fa, planned_event_fa)) / planned_event_fa
126-
#' gs_update_ahr(
127-
#' x = x,
128-
#' ustime = ustime,
129-
#' observed_data = list(observed_data_ia, observed_data_fa))
130-
#'
131-
#' # alpha is upadted to 0.05
132-
#' gs_update_ahr(
133-
#' x = x,
134-
#' alpha = 0.05,
135-
#' ustime = ustime,
136-
#' observed_data = list(observed_data_ia, observed_data_fa))
137-
#'
138-
#' # ------------------------------------------------- #
139-
#' # Example B: Two-sided asymmetric design,
69+
#' # Two-sided asymmetric design,
14070
#' # beta-spending with non-binding lower bound
14171
#' # ------------------------------------------------- #
14272
#' # Original design
@@ -153,83 +83,48 @@
15383
#' test_lower = c(TRUE, FALSE),
15484
#' binding = FALSE) |> to_integer()
15585
#'
156-
#' # Example B1 ----
157-
#' # IA spending = observed events / final planned events
158-
#' # the remaining alpha will be allocated to FA.
159-
#' ustime <- c(observed_event_ia / planned_event_fa, 1)
160-
#' gs_update_ahr(
161-
#' x = x,
162-
#' ustime = ustime,
163-
#' lstime = ustime,
164-
#' observed_data = list(observed_data_ia, observed_data_fa))
86+
#' planned_event_ia <- x$analysis$event[1]
87+
#' planned_event_fa <- x$analysis$event[2]
16588
#'
166-
#' # Example B2 ----
167-
#' # IA, FA spending = observed events / final planned events
168-
#' ustime <- c(observed_event_ia, observed_event_fa) / planned_event_fa
169-
#' gs_update_ahr(
170-
#' x = x,
171-
#' ustime = ustime,
172-
#' lstime = ustime,
173-
#' observed_data = list(observed_data_ia, observed_data_fa))
17489
#'
175-
#' # Example B3 ----
176-
#' ustime <- c(min(observed_event_ia, planned_event_ia) / planned_event_fa, 1)
90+
#' # Updated design with 190 events observed at IA,
91+
#' # where 50 events observed during the delayed effect.
92+
#' # IA spending = observed events / final planned events, the remaining alpha will be allocated to FA.
17793
#' gs_update_ahr(
17894
#' x = x,
179-
#' ustime = ustime,
180-
#' lstime = ustime,
181-
#' observed_data = list(observed_data_ia, observed_data_fa))
95+
#' ustime = c(190 / planned_event_fa, 1),
96+
#' lstime = c(190 / planned_event_fa, 1),
97+
#' event_tbl = data.frame(analysis = c(1, 1),
98+
#' event = c(50, 140)))
18299
#'
183-
#' # Example B4 ----
184-
#' # IA spending = min(observed events, planned events) / final planned events
185-
#' ustime <- c(min(observed_event_ia, planned_event_ia),
186-
#' min(observed_event_fa, planned_event_fa)) / planned_event_fa
100+
#' # Updated design with 190 events observed at IA, and 300 events observed at FA,
101+
#' # where 50 events observed during the delayed effect.
102+
#' # IA spending = observed events / final planned events, the remaining alpha will be allocated to FA.
187103
#' gs_update_ahr(
188104
#' x = x,
189-
#' ustime = ustime,
190-
#' lstime = ustime,
191-
#' observed_data = list(observed_data_ia, observed_data_fa))
105+
#' ustime = c(190 / planned_event_fa, 1),
106+
#' lstime = c(190 / planned_event_fa, 1),
107+
#' event_tbl = data.frame(analysis = c(1, 1, 2, 2),
108+
#' event = c(50, 140, 50, 250)))
192109
#'
193-
#' # Example B5 ----
194-
#' # alpha is updated to 0.05 ----
195-
#' gs_update_ahr(x = x, alpha = 0.05)
196-
#'
197-
#' # Example B6 ----
198-
#' # updated boundaries only when IA data is observed
199-
#' ustime <- c(observed_event_ia / planned_event_fa, 1)
110+
#' # Updated design with 190 events observed at IA, and 300 events observed at FA,
111+
#' # where 50 events observed during the delayed effect.
112+
#' # IA spending = minimal of planned and actual information fraction spending
200113
#' gs_update_ahr(
201114
#' x = x,
202-
#' ustime = ustime,
203-
#' lstime = ustime,
204-
#' observed_data = list(observed_data_ia, NULL))
205-
#'
206-
#' # ------------------------------------------------- #
207-
#' # Example C: Two-sided asymmetric design,
208-
#' # with calendar spending for efficacy and futility bounds
209-
#' # beta-spending with non-binding lower bound
210-
#' # ------------------------------------------------- #
211-
#' # Original design
212-
#' x <- gs_design_ahr(
213-
#' enroll_rate = enroll_rate, fail_rate = fail_rate,
214-
#' alpha = alpha, beta = beta, ratio = ratio,
215-
#' info_scale = "h0_info",
216-
#' info_frac = NULL, analysis_time = c(20, 36),
217-
#' upper = gs_spending_bound,
218-
#' upar = list(sf = sfLDOF, total_spend = alpha, timing = c(20, 36) / 36),
219-
#' test_upper = TRUE,
220-
#' lower = gs_spending_bound,
221-
#' lpar = list(sf = sfLDOF, total_spend = beta, timing = c(20, 36) / 36),
222-
#' test_lower = c(TRUE, FALSE),
223-
#' binding = FALSE) |> to_integer()
115+
#' ustime = c(min(190, planned_event_ia) / planned_event_fa, 1),
116+
#' lstime = c(min(190, planned_event_ia) / planned_event_fa, 1),
117+
#' event_tbl = data.frame(analysis = c(1, 1, 2, 2),
118+
#' event = c(50, 140, 50, 250)))
224119
#'
225-
#' # Updated design due to potential change of multiplicity graph
120+
#' # Alpha is updated to 0.05
226121
#' gs_update_ahr(x = x, alpha = 0.05)
227122
gs_update_ahr <- function(
228123
x = NULL,
229124
alpha = NULL,
230125
ustime = NULL,
231126
lstime = NULL,
232-
observed_data = NULL) {
127+
event_tbl = NULL) {
233128

234129
# ----------------------------------- #
235130
# Check inputs #
@@ -277,10 +172,9 @@ gs_update_ahr <- function(
277172
# At design stage, #
278173
# with different alpha #
279174
# ----------------------------------- #
280-
# If users do not input observed data
281-
# which means they are still at the design stage
282-
# but with different alpha
283-
if (is.null(observed_data)) {
175+
# If users do not input observed data, nor event_tbl
176+
# which means they update design with a different value of alpha
177+
if (is.null(event_tbl)) {
284178

285179
# Check if ustime and lstime matches the spending time of the original design
286180
if (!is.null(ustime) && any(ustime != x$input$upar$timing)) {
@@ -337,24 +231,11 @@ gs_update_ahr <- function(
337231
# At analysis stage, #
338232
# with different alpha #
339233
# ----------------------------------- #
340-
# Get the piecewise exp model for the failure rates
341-
fr_duration <- x$input$fail_rate$duration
342-
fr_hr <- x$input$fail_rate$hr
343-
all_t <- sort(c(fr_duration, x$analysis$time))
344-
345-
if (is.infinite(max(x$input$fail_rate$duration))) {
346-
hr_interval <- cumsum(c(fr_duration[-length(fr_duration)], max(x$analysis$time) + 50))
347-
} else {
348-
hr_interval <- cumsum(fr_duration)
349-
}
350-
351-
pw_hr <- stepfun(x = hr_interval, y = c(fr_hr, last(fr_hr)), right = TRUE)
352-
353234
# Calculate the blinded estimation of AHR
354235
blinded_est <- NULL
355236
observed_event <- NULL
356237
for (i in 1:n_analysis) {
357-
if (is.null(observed_data[[i]])) {
238+
if (!(i %in% event_tbl$analysis)) {
358239
# if there is no observed data at analysis i,
359240
# for example, we only observed IA data and FA data is unavailable yet
360241
blinded_est_new <- data.frame(event = x$analysis$event[i],
@@ -363,14 +244,15 @@ gs_update_ahr <- function(
363244
info0 = x$analysis$info0[i])
364245
event_new <- x$analysis$event[i]
365246
} else {
366-
# if there is observed data at analysis i,
367-
# we calculate the blinded estimation
368-
blinded_est_new <- ahr_blinded(surv = survival::Surv(time = observed_data[[i]]$tte,
369-
event = observed_data[[i]]$event),
370-
intervals = all_t[all_t <= x$analysis$time[i]],
371-
hr = pw_hr(all_t[all_t <= x$analysis$time[i]]),
372-
ratio = x$input$ratio)
373-
event_new <- sum(observed_data[[i]]$event)
247+
q_e <- x$input$ratio / (1 + x$input$ratio)
248+
event_i <- event_tbl$event[event_tbl$analysis == i]
249+
hr_i <- x$fail_rate$hr
250+
event_new <- sum(event_i)
251+
252+
blinded_est_new <- data.frame(event = sum(event_i),
253+
theta = -sum(log(hr_i) * event_i) / sum(event_i),
254+
info0 = sum(event_i) * (1 - q_e) * q_e)
255+
blinded_est_new$ahr <- exp(-blinded_est_new$theta)
374256
}
375257

376258
blinded_est <- rbind(blinded_est, blinded_est_new)
@@ -441,37 +323,37 @@ gs_update_ahr <- function(
441323
analysis = 1:n_analysis,
442324
time = x$analysis$time,
443325
n = x$analysis$n,
444-
event = if (is.null(observed_data)) {
326+
event = if (is.null(event_tbl)) {
445327
x$analysis$event
446328
} else {
447329
observed_event
448330
},
449-
ahr = if (is.null(observed_data)) {
331+
ahr = if (is.null(event_tbl)) {
450332
x$analysis$ahr
451333
} else {
452334
exp(-blinded_est$theta)
453335
},
454-
theta = if (is.null(observed_data)) {
336+
theta = if (is.null(event_tbl)) {
455337
x$analysis$theta
456338
} else {
457339
blinded_est$theta
458340
},
459-
info = if (is.null(observed_data)) {
341+
info = if (is.null(event_tbl)) {
460342
x$analysis$info
461343
} else {
462344
blinded_est$info0
463345
},
464-
info0 = if (is.null(observed_data)) {
346+
info0 = if (is.null(event_tbl)) {
465347
x$analysis$info0
466348
} else {
467349
blinded_est$info0
468350
},
469-
info_frac = if (is.null(observed_data)) {
351+
info_frac = if (is.null(event_tbl)) {
470352
x$analysis$info_frac
471353
} else {
472354
upar_update$timing
473355
},
474-
info_frac0 = if (is.null(observed_data)) {
356+
info_frac0 = if (is.null(event_tbl)) {
475357
x$analysis$info_frac0
476358
} else {
477359
observed_event / max(observed_event)

0 commit comments

Comments
 (0)