chendun1995/tte-surgery
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

D55: EHR/registry-like world (noisy severity), non-random trial consent, trial analyses at 12/24/60 months

Browse Source 
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
chendun1995
2026-10-28 16:26:01 -04:00
co-authored by Claude Opus 5.5
parent 307f75b63e
commit d369a16208
8 changed files with 72 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
simulations/04_summarise.R
+14 -4
View File
@@ -14,6 +14,9 @@ cat(sprintf("%d files, %d rows\n", length(files), nrow(d)))
# rare failures (sequential V4: fixed effects not estimable in a trial month) are dropped and counted
cat(sprintf("dropped %d estimates with NA\n", d[is.na(est), .N]))
d <- d[!is.na(est)]
# trials are analysed at 12, 24 and 60 months (D55); everything else at 60
if (!"horizon" %in% names(d)) d[, horizon := NA_integer_]
d[is.na(horizon), horizon := 60L]
tr <- rbind(fread("simulations/truths/truths.csv"), fread("simulations/truths/truths_rct.csv"))
tr <- tr[, .(world, scenario, outcome, estimand, truth = value, truth_mcse = mcse)]
@@ -23,12 +26,19 @@ tr <- tr[, .(world, scenario, outcome, estimand, truth = value, truth_mcse = mcs
d[, estimand := fcase(design == "ccw" & contrast == "A_B1", "rd_A_B1",
design == "ccw" & contrast == "A_B2", "rd_A_B2",
design == "seq", "seq_itt",
design %like% "^rct_" & contrast == "itt", paste0(design, "_itt"),
design %like% "^rct_" & contrast == "itt",
paste0(design, "_itt", fifelse(horizon == 60L, "", paste0("_h", horizon))),
default = NA_character_)]
d <- merge(d, tr[, .(world, scenario, outcome, estimand, own = truth)],
by = c("world", "scenario", "outcome", "estimand"), all.x = TRUE)
d <- merge(d, tr[estimand == "rd_A_B1", .(world, scenario, outcome, ref = truth)],
by = c("world", "scenario", "outcome"), all.x = TRUE)
# at the shorter trial horizons the reference is RD(A - B1) at that month, from the risk curves
cv <- dcast(fread("simulations/truths/risk_curves.csv")[policy %in% c("A", "B1")],
world + scenario + outcome + month ~ policy, value.var = "cuminc")
d <- merge(d, cv[, .(world, scenario, outcome, horizon = month, ref_h = A - B1)],
by = c("world", "scenario", "outcome", "horizon"), all.x = TRUE)
d[horizon != 60L, ref := ref_h][, ref_h := NULL]
# landmark and naive: own estimand = the paired oracle estimate in the same replicate (D47)
orc <- d[variant == "oracle", .(world, scenario, rep, design, outcome, oracle = est)]
d <- merge(d, orc, by = c("world", "scenario", "rep", "design", "outcome"), all.x = TRUE)
@@ -39,7 +49,7 @@ d[, `:=`(lo = est - 1.96 * se, hi = est + 1.96 * se)]
fwrite(d, file.path(outdir, "reps.csv"))
# ---- performance by cell (plan 9) -----------------------------------------------------
keys <- c("world", "scenario", "analysis", "design", "contrast", "variant", "outcome")
keys <- c("world", "scenario", "analysis", "design", "contrast", "variant", "outcome", "horizon")
perf <- d[variant != "oracle", {
err <- est - own; R <- .N; own_m <- mean(own)
.(reps = R, mean_est = mean(est), own = own_m, ref = ref[1],
@@ -83,8 +93,8 @@ ncs <- rbindlist(lapply(c("nco1", "nco2", "nce", "any_nc"), function(k) rbind(
nc[, c(control = k, level = "cell", acc(get(k), biased_cell)), by = world],
nc[, c(world = "all", control = k, level = "replicate", acc(get(k), biased_rep))],
nc[, c(world = "all", control = k, level = "cell", acc(get(k), biased_cell))])))
hide <- nc[any_nc == FALSE, .(control = "any_nc", med_absbias_clean = median(abs(cell_bias)),
p90_absbias_clean = quantile(abs(cell_bias), 0.9)), by = world]
hide <- nc[any_nc == FALSE, .(control = "any_nc", med_absbias_clean = median(abs(cell_bias), na.rm = TRUE),
p90_absbias_clean = quantile(abs(cell_bias), 0.9, na.rm = TRUE)), by = world]
ncs <- merge(ncs, hide, by = c("world", "control"), all.x = TRUE)
fwrite(ncs, file.path(outdir, "nc_summary.csv"))
cat("wrote", outdir, "\n")