# Storage for results
results <- vector("list", n_sims)
for (sim in 1:n_sims) {
# Simulate trial data
sim_data <- nb_sim(
enroll_rate = enroll_rate,
fail_rate = fail_rate,
dropout_rate = dropout_rate,
max_followup = max_followup,
n = n_target
)
# Analyze at each interim
sim_results <- data.frame(
sim = sim,
analysis = 1:3,
analysis_time = analysis_times,
n_enrolled = NA_integer_,
events_ctrl = NA_integer_,
events_exp = NA_integer_,
events_total = NA_integer_,
exposure_ctrl = NA_real_,
exposure_exp = NA_real_,
blinded_info = NA_real_,
unblinded_info = NA_real_,
z_stat = NA_real_,
p_value = NA_real_,
cross_upper = NA,
cross_lower = NA
)
stopped <- FALSE
for (k in 1:3) {
if (stopped) {
# Trial already stopped at earlier analysis
sim_results$cross_upper[k] <- FALSE
sim_results$cross_lower[k] <- FALSE
next
}
# Cut data at analysis time
cut_time <- analysis_times[k]
cut_data <- cut_data_by_date(sim_data, cut_date = cut_time, event_gap = event_gap_val)
# Count enrolled subjects (those with enroll_time <= cut_time)
enrolled <- unique(sim_data$id[sim_data$enroll_time <= cut_time])
cut_data <- cut_data[cut_data$id %in% enrolled, ]
# Summary by treatment
summary_dt <- as.data.table(cut_data)[
,
.(n = .N, events = sum(events), exposure = sum(tte)),
by = treatment
]
ctrl_row <- summary_dt[treatment == "Control"]
exp_row <- summary_dt[treatment == "Experimental"]
sim_results$n_enrolled[k] <- nrow(cut_data)
sim_results$events_ctrl[k] <- if (nrow(ctrl_row) > 0) ctrl_row$events else 0
sim_results$events_exp[k] <- if (nrow(exp_row) > 0) exp_row$events else 0
sim_results$events_total[k] <- sim_results$events_ctrl[k] + sim_results$events_exp[k]
sim_results$exposure_ctrl[k] <- if (nrow(ctrl_row) > 0) ctrl_row$exposure else 0
sim_results$exposure_exp[k] <- if (nrow(exp_row) > 0) exp_row$exposure else 0
# Run Mütze test
if (nrow(cut_data) >= 4 && sim_results$events_total[k] >= 2) {
test_result <- tryCatch(
mutze_test(cut_data),
error = function(e) NULL
)
if (!is.null(test_result)) {
sim_results$z_stat[k] <- test_result$z
sim_results$p_value[k] <- test_result$p_value
# Calculate unblinded information using the variance from the GLM
sim_results$unblinded_info[k] <- 1 / test_result$se^2
# Calculate blinded information and update bounds
blinded_est <- calculate_blinded_info(
cut_data,
ratio = nb_ss$inputs$ratio,
lambda1_planning = nb_ss$inputs$lambda1,
lambda2_planning = nb_ss$inputs$lambda2,
event_gap = event_gap_val
)
sim_results$blinded_info[k] <- blinded_est$blinded_info
# Update design with observed information fraction
max_info <- gs_nb$n.fix
# If observed info >= max info, this must be the final analysis
if (blinded_est$blinded_info >= max_info) {
# Only if not already at the final analysis
if (k < 3) {
# Consider this the final analysis for this simulation
# We need to treat this as if k were the final analysis index
# But the loop structure expects k=3 to be final.
# Effectively, we have reached 100% info early.
frac <- 1
} else {
frac <- 1
}
} else if (k == 3) {
frac <- 1
} else {
frac <- blinded_est$blinded_info / max_info
}
# Current timing
current_timing <- gs_nb$timing
current_timing[k] <- frac
# Safety check for timing order
if (k > 1 && current_timing[k] <= current_timing[k-1]) current_timing[k] <- current_timing[k-1] + 0.001
# If we have reached full information early (frac >= 1), adjust timing
if (frac >= 1 && k < 3) {
# Set current timing to 1
current_timing[k] <- 1
# Set subsequent timings to 1 as well (though they won't be reached ideally,
# gsDesign needs valid input)
current_timing[(k+1):3] <- 1
# Note: gsDesign might complain if timing is 1 at interim.
# Actually gsDesign requires timing to be increasing and < 1 for interims usually.
# If information fraction > 1, we should probably stop the trial.
stopped <- TRUE
}
if (k < 3 && current_timing[k+1] <= current_timing[k]) {
# Ensure strict monotonicity if not already at 1
if (current_timing[k] < 1) {
current_timing[k+1] <- min(current_timing[k] + 0.001, 0.999)
}
}
# Recompute bounds
# We only recompute if we haven't exceeded information
if (frac <= 1 || k == 3) {
temp_gs <- gsDesign::gsDesign(
k = 3,
test.type = 4,
alpha = 0.025,
beta = 0.1,
sfu = gsDesign::sfLinear, sfupar = c(.5, .5),
sfl = gsDesign::sfHSD, sflpar = -8,
usTime = c(.1, .18, 1),
timing = current_timing,
n.fix = max_info
)
upper_bound <- temp_gs$upper$bound[k]
lower_bound <- temp_gs$lower$bound[k]
# Check boundaries (one-sided: reject if z < -upper bound for benefit)
# For rate ratio < 1 (experimental better), log(RR) < 0, so z < 0
z_eff <- -test_result$z # Flip sign for efficacy direction
sim_results$cross_upper[k] <- z_eff > upper_bound
sim_results$cross_lower[k] <- z_eff < lower_bound
if (sim_results$cross_upper[k] || sim_results$cross_lower[k]) {
stopped <- TRUE
}
} else {
# Information limit reached early
# We should check against final bound, but technically this is an overrun
# For simplicity here, we stop.
stopped <- TRUE
}
}
}
}
results[[sim]] <- sim_results
}
# Combine all results
all_results <- do.call(rbind, results)
