25
25
# ' with the spending time at each analysis.
26
26
# ' @param lstime Default is NULL in which case lower bound spending time is determined by timing.
27
27
# ' 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.
30
38
# '
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.
32
40
# '
33
41
# ' @export
34
42
# '
58
66
# ' ratio <- 1
59
67
# '
60
68
# ' # ------------------------------------------------- #
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,
140
70
# ' # beta-spending with non-binding lower bound
141
71
# ' # ------------------------------------------------- #
142
72
# ' # Original design
153
83
# ' test_lower = c(TRUE, FALSE),
154
84
# ' binding = FALSE) |> to_integer()
155
85
# '
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]
165
88
# '
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))
174
89
# '
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.
177
93
# ' gs_update_ahr(
178
94
# ' 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)))
182
99
# '
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.
187
103
# ' gs_update_ahr(
188
104
# ' 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)))
192
109
# '
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
200
113
# ' gs_update_ahr(
201
114
# ' 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)))
224
119
# '
225
- # ' # Updated design due to potential change of multiplicity graph
120
+ # ' # Alpha is updated to 0.05
226
121
# ' gs_update_ahr(x = x, alpha = 0.05)
227
122
gs_update_ahr <- function (
228
123
x = NULL ,
229
124
alpha = NULL ,
230
125
ustime = NULL ,
231
126
lstime = NULL ,
232
- observed_data = NULL ) {
127
+ event_tbl = NULL ) {
233
128
234
129
# ----------------------------------- #
235
130
# Check inputs #
@@ -277,10 +172,9 @@ gs_update_ahr <- function(
277
172
# At design stage, #
278
173
# with different alpha #
279
174
# ----------------------------------- #
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 )) {
284
178
285
179
# Check if ustime and lstime matches the spending time of the original design
286
180
if (! is.null(ustime ) && any(ustime != x $ input $ upar $ timing )) {
@@ -337,24 +231,11 @@ gs_update_ahr <- function(
337
231
# At analysis stage, #
338
232
# with different alpha #
339
233
# ----------------------------------- #
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
-
353
234
# Calculate the blinded estimation of AHR
354
235
blinded_est <- NULL
355
236
observed_event <- NULL
356
237
for (i in 1 : n_analysis ) {
357
- if (is.null( observed_data [[ i ]] )) {
238
+ if (! ( i %in% event_tbl $ analysis )) {
358
239
# if there is no observed data at analysis i,
359
240
# for example, we only observed IA data and FA data is unavailable yet
360
241
blinded_est_new <- data.frame (event = x $ analysis $ event [i ],
@@ -363,14 +244,15 @@ gs_update_ahr <- function(
363
244
info0 = x $ analysis $ info0 [i ])
364
245
event_new <- x $ analysis $ event [i ]
365
246
} 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 )
374
256
}
375
257
376
258
blinded_est <- rbind(blinded_est , blinded_est_new )
@@ -441,37 +323,37 @@ gs_update_ahr <- function(
441
323
analysis = 1 : n_analysis ,
442
324
time = x $ analysis $ time ,
443
325
n = x $ analysis $ n ,
444
- event = if (is.null(observed_data )) {
326
+ event = if (is.null(event_tbl )) {
445
327
x $ analysis $ event
446
328
} else {
447
329
observed_event
448
330
},
449
- ahr = if (is.null(observed_data )) {
331
+ ahr = if (is.null(event_tbl )) {
450
332
x $ analysis $ ahr
451
333
} else {
452
334
exp(- blinded_est $ theta )
453
335
},
454
- theta = if (is.null(observed_data )) {
336
+ theta = if (is.null(event_tbl )) {
455
337
x $ analysis $ theta
456
338
} else {
457
339
blinded_est $ theta
458
340
},
459
- info = if (is.null(observed_data )) {
341
+ info = if (is.null(event_tbl )) {
460
342
x $ analysis $ info
461
343
} else {
462
344
blinded_est $ info0
463
345
},
464
- info0 = if (is.null(observed_data )) {
346
+ info0 = if (is.null(event_tbl )) {
465
347
x $ analysis $ info0
466
348
} else {
467
349
blinded_est $ info0
468
350
},
469
- info_frac = if (is.null(observed_data )) {
351
+ info_frac = if (is.null(event_tbl )) {
470
352
x $ analysis $ info_frac
471
353
} else {
472
354
upar_update $ timing
473
355
},
474
- info_frac0 = if (is.null(observed_data )) {
356
+ info_frac0 = if (is.null(event_tbl )) {
475
357
x $ analysis $ info_frac0
476
358
} else {
477
359
observed_event / max(observed_event )
0 commit comments