Truths, estimators (naive, landmark, CCW, sequential; physician variants V1-V4) and simulated RCTs

- truths.R: interventional truths by common random numbers (A, B1, B2, sequential ITT)
- estimators.R: weighted Aalen-Johansen with influence-function SEs (patient / physician cluster)
- rct.R: realistic and ideal trials, ITT and as-treated; RCT ITT truths
- scenario effects tuned in W0: harm +5.1 pp, benefit-then-harm -1.2 pp at 24 mo, +3.1 at 60

Co-Authored-By: Claude Opus 5.5 <[email protected]>

simulations/02_truths.R

@@ -0,0 +1,20 @@
+# Interventional truths for every world x scenario (plan section 5.5).
+# Usage: Rscript simulations/02_truths.R [n] [cores]
+# Writes simulations/truths/truths.csv and simulations/truths/risk_curves.csv.
+
+pkgload::load_all("pvisim", quiet = TRUE)
+suppressPackageStartupMessages(library(data.table))
+args <- commandArgs(TRUE)
+n <- if (length(args) >= 1) as.numeric(args[1]) else 1e6
+cores <- if (length(args) >= 2) as.integer(args[2]) else 6L
+
+raw <- yaml::read_yaml(default_params_path())
+jobs <- CJ(world = names(raw$worlds), scenario = names(raw$scenarios), sorted = FALSE)
+res <- parallel::mclapply(seq_len(nrow(jobs)), function(i)
+  compute_truths(jobs$world[i], jobs$scenario[i], n = n), mc.cores = cores)
+bad <- vapply(res, inherits, TRUE, "try-error")
+if (any(bad)) stop("failed: ", paste(jobs$world[bad], jobs$scenario[bad], collapse = "; "), "\n", res[bad][[1]])
+dir.create("simulations/truths", showWarnings = FALSE)
+fwrite(rbindlist(lapply(res, `[[`, "truths")), "simulations/truths/truths.csv")
+fwrite(rbindlist(lapply(res, `[[`, "curves")), "simulations/truths/risk_curves.csv")
+cat("wrote simulations/truths/truths.csv\n")

simulations/explore_scenarios.R

@@ -0,0 +1,17 @@
+# Explore effect sizes: RD(A - B1) by month for MALE and the disease composite in W0.
+pkgload::load_all("pvisim", quiet = TRUE)
+suppressMessages(library(data.table))
+args <- commandArgs(TRUE)
+grid <- if (length(args)) eval(parse(text = args[1])) else
+  list(c(0, 0), c(0.3, 0.03), c(1.2, 0.04))
+par0 <- load_params("W0", "null")
+pop <- make_population(par0, n = 2e5, seed = 9L)
+ci <- function(t, h) mean(!is.na(t) & t < h)
+for (g in grid) {
+  par <- load_params("W0", "null", overrides = list(effect = list(relief = g[1], kappa = g[2])))
+  ev <- lapply(c("A", "B1"), function(p) simulate_course(pop, par, policy(p), seed = 10L, record = FALSE)$events)
+  rd <- function(col, h) 100 * (ci(ev[[1]][[col]], h) - ci(ev[[2]][[col]], h))
+  cat(sprintf("relief %.2f kappa %.3f | disease RD @12 %+.1f @24 %+.1f @60 %+.1f | MALE RD @60 %+.1f (A %.1f%% B1 %.1f%%) | death RD %+.2f\n",
+              g[1], g[2], rd("t_disease", 12), rd("t_disease", 24), rd("t_disease", 60), rd("t_male", 60),
+              100 * ci(ev[[1]]$t_male, 60), 100 * ci(ev[[2]]$t_male, 60), rd("t_death", 60)))
+}

simulations/validate_designs.R

@@ -0,0 +1,33 @@
+# Validation (plan section 15): in a clean world, each design averaged over replicates
+# should match its own truth within Monte Carlo error.
+# Usage: Rscript simulations/validate_designs.R [world] [scenario] [reps] [cores] [n]
+
+pkgload::load_all("pvisim", quiet = TRUE)
+suppressPackageStartupMessages(library(data.table))
+a <- commandArgs(TRUE)
+world <- if (length(a) >= 1) a[1] else "W0"
+scenario <- if (length(a) >= 2) a[2] else "harm"
+reps <- if (length(a) >= 3) as.integer(a[3]) else 40L
+cores <- if (length(a) >= 4) as.integer(a[4]) else 10L
+n <- if (length(a) >= 5) as.numeric(a[5]) else 5e4
+
+par <- load_params(world, scenario)
+res <- rbindlist(parallel::mclapply(seq_len(reps), function(r) {
+  rec <- simulate_records(par, rep = 1000L + r, n = n)
+  rbindlist(lapply(c("naive", "landmark", "ccw", "seq"), function(d)
+    cbind(rep = r, run_design(rec, d, "V1_ignore", outcomes = c(male = "t_male", disease = "t_disease", nco1 = "t_nco1")))),
+    fill = TRUE)
+}, mc.cores = cores), fill = TRUE)
+
+tr <- fread("simulations/truths/truths.csv")[world == ..world & scenario == ..scenario]
+map <- data.table(design = c("ccw", "ccw", "seq"), contrast = c("A_B1", "A_B2", "now_not"),
+                  estimand = c("rd_A_B1", "rd_A_B2", "seq_itt"))
+s <- res[, .(mean_est = mean(est), emp_se = sd(est), mean_se = mean(se), reps = .N),
+         by = .(design, contrast, outcome)]
+s <- merge(s, map, by = c("design", "contrast"), all.x = TRUE)
+s <- merge(s, tr[, .(outcome, estimand, truth = value)], by = c("outcome", "estimand"), all.x = TRUE)
+s[, `:=`(bias = mean_est - truth, mcse_bias = emp_se / sqrt(reps))]
+s[, z := bias / mcse_bias]
+print(s[order(design, outcome), .(design, contrast, outcome, truth = round(truth, 4), mean_est = round(mean_est, 4),
+          bias = round(bias, 4), z = round(z, 1), emp_se = round(emp_se, 4), mean_se = round(mean_se, 4))])
+fwrite(res, sprintf("results/validate_%s_%s.csv", world, scenario))