---
title: "Early vs delayed PVI for claudication: known-truth simulation, draft results"
subtitle: "Draft scale: n = 50,000 patients, 100 replicates per world x scenario"
date: "`r format(Sys.Date())`"
output:
  html_document:
    toc: true
    toc_float: true
    self_contained: true
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, fig.align = "center", dpi = 120)
suppressPackageStartupMessages({ library(data.table); library(ggplot2); library(patchwork) })
root <- normalizePath("..")
S <- file.path(root, "results", "summary")
perf <- fread(file.path(S, "perf.csv")); nc <- fread(file.path(S, "nc_reps.csv"))
ncs <- fread(file.path(S, "nc_summary.csv")); reps <- fread(file.path(S, "reps.csv"))

WORLDS <- c("W0", "W1", "W1_rho0", "W2", "W3", "W4", "W5", "WR")
WLAB <- c(W0 = "W0 Clean", W1 = "W1 Skill", W1_rho0 = "W1 Skill (rho 0)", W2 = "W2 Style",
          W3 = "W3 Style -> outcome", W4 = "W4 Deferral", W5 = "W5 Unmeasured severity", WR = "WR Realistic")
VAR <- c(V2_cluster = "Ignore physician (cluster SE)", V3_random = "Random intercept",
         V4_within = "Within-physician (FE)", none = "Trial (no adjustment)")
VCOL <- c("Ignore physician (cluster SE)" = "#2a78d6", "Random intercept" = "#eb6834",
          "Within-physician (FE)" = "#1baf7a", "Trial (no adjustment)" = "#52514e")
METH <- data.table(
  k = c("ccw|A_B1", "ccw|A_B2", "seq|now_not", "landmark|early_none", "landmark_m5|early_none", "naive|early_none",
          "rct_realistic|itt", "rct_ideal|itt", "rct_realistic|as_treated", "rct_ideal|as_treated"),
  method = c("CCW, A vs B1 (reference)", "CCW, A vs B2", "Sequential trials, ITT", "Landmark at 6 months", "Landmark, + month-5 severity (suppl.)",
             "Naive 'ever early PVI'", "Realistic RCT (n = 240), ITT", "Ideal pragmatic RCT, ITT",
             "Realistic RCT, as-treated", "Ideal RCT, as-treated"))
setnames(METH, "k", "key")
pp <- function(x, k = 1) formatC(100 * x, format = "f", digits = k)
theme_set(theme_minimal(base_size = 11) + theme(panel.grid.minor = element_blank(),
          panel.grid.major.y = element_blank(), strip.text = element_text(face = "bold", hjust = 0),
          legend.position = "bottom"))
perf <- perf[analysis %in% c("main", "rct")]   # NCE analyses are used only in Table 4
perf[, key := paste(design, contrast, sep = "|")]
perf <- merge(perf, METH, by = "key")
perf[, method := factor(method, levels = rev(METH$method))]
perf[, wlab := factor(WLAB[world], levels = WLAB[WORLDS])]
perf[, vlab := factor(VAR[variant], levels = VAR)]
```

# Read this first

* **Run.** 8 worlds × 3 truth scenarios × 100 replicates of 50,000 patients (about 1,500 physicians per
  replicate). Each replicate runs naive, landmark, CCW and sequential trials under 4 physician
  variants, 3 negative controls, an oracle run, and 2 simulated RCTs. 2,400 replicate files, 0
  errors. 16 of 288,000 estimates are missing (sequential trials with physician fixed effects, 4
  replicates), and these are dropped.
* **Outcome shown.** The headline outcome is the **disease composite (CLTI or major amputation)**,
  whose true effect under the null is exactly 0 (D34). MALE is shown where it adds something.
* **Two errors, kept separate (D27).** *Estimation bias* = mean estimate − the method's own truth.
  *Question gap* = the method's own truth − the reference truth (CCW A vs B1). *Total error* is the sum.
* **Variants shown.** "Ignore physician" is V1's point estimate with the cluster-robust SE (V2).
  The V1 patient-level SE is in the supplement tables.
* **Two open questions** came out of this run (Section 6). They affect the landmark results and the
  negative-control results, so treat those parts as provisional.

# 1. Aim 1: what each method answers (clean world W0)

```{r tab2}
t2 <- perf[world == "W0" & outcome == "disease" & variant %in% c("V2_cluster", "none") &
             !grepl("as_treated", key)]
t2 <- t2[, .(Scenario = scenario, Method = as.character(method), `Reference truth` = pp(ref),
             `Own truth` = pp(own), `Question gap` = pp(gap), `Mean estimate` = pp(mean_est),
             `Estimation bias (MCSE)` = sprintf("%s (%s)", pp(bias, 2), pp(mcse_bias, 2)),
             `Empirical SE` = pp(emp_se), `Coverage of own truth` = sprintf("%.0f%%", 100 * cover_own))]
t2[, Scenario := factor(Scenario, levels = c("null", "harm", "benefit_harm"))]
t2[, Method := factor(Method, levels = METH$method)]
knitr::kable(t2[order(Scenario, Method)], align = "llrrrrrrr",
  caption = "Table 2. Disease composite, 5-year risk difference in percentage points, world W0.")
```

**What it shows.**

* Every TTE method is close to unbiased for **its own** truth in W0 (all |bias| < 0.35 pp). H1a holds.
* The methods answer **different questions**. Under harm (reference +5.1 pp): sequential trials target
  +5.7, landmark +7.9 and naive +7.2. So the question gap alone is 0.6–2.8 pp. Under the null, naive
  has a gap of +1.3 pp from immortal time even with every confounder measured. H1b holds, though the
  gap for the sequential trials is small.
* **CCW is right but imprecise.** Its empirical SE is about 2.8 pp at n = 50,000, against about 1.5 pp for
  sequential trials. Under the null its 95% CI excludes 0 in 15% of replicates (Section 3).
* The **realistic RCT (n = 240)** is unbiased for its own ITT, but its SE is about 4.2 pp. It detects
  the 5-point harm in only 25% of replicates.

```{r fig1, fig.width = 11, fig.height = 9}
ladder <- function(sc, oc = "disease") {
  x <- perf[scenario == sc & outcome == oc & variant != "V1_ignore" & !grepl("as_treated", key)]
  r <- reps[scenario == sc & outcome == oc & analysis %in% c("main", "rct") & variant != "V1_ignore" &
              variant != "oracle" & !grepl("as_treated", contrast)]
  r[, key := paste(design, contrast, sep = "|")]
  q <- r[, .(lo = quantile(est, 0.025), hi = quantile(est, 0.975)), by = .(world, key, variant)]
  x <- merge(x, q, by = c("world", "key", "variant"))
  dodge <- position_dodge(width = 0.6)
  ggplot(x, aes(y = method, group = vlab)) +
    geom_vline(aes(xintercept = 100 * ref), colour = "#0b0b0b", linewidth = 0.4) +
    geom_vline(xintercept = 0, colour = "#c3c2b7", linewidth = 0.3, linetype = 2) +
    geom_linerange(aes(xmin = 100 * lo, xmax = 100 * hi, colour = vlab), position = dodge, linewidth = 0.6) +
    geom_point(aes(x = 100 * own), position = dodge, shape = 21, size = 2.6, fill = "white", colour = "#0b0b0b") +
    geom_point(aes(x = 100 * mean_est, colour = vlab), position = dodge, size = 2) +
    facet_wrap(~wlab, ncol = 4) + scale_colour_manual(values = VCOL, name = NULL) +
    labs(x = "5-year risk difference, early − delayed (percentage points)", y = NULL,
         caption = paste("Filled dot: mean estimate (bar: 2.5th–97.5th percentile across replicates).",
                         "Hollow dot: the method's own truth. Solid line: the reference truth (CCW A vs B1).")) +
    coord_cartesian(xlim = c(-15, 35))
}
ladder("harm") + ggtitle("Figure 1a. Estimand ladder, harm scenario (disease composite)")
```

```{r fig1b, fig.width = 11, fig.height = 9}
ladder("null") + ggtitle("Figure 1b. Estimand ladder, null scenario (disease composite)")
```

# 2. Aim 2: surgery-specific threats

```{r tab3}
x <- perf[scenario == "harm" & outcome == "disease" & analysis == "main" &
            variant %in% c("V2_cluster", "V3_random", "V4_within") & key != "ccw|A_B2"]
x[, cell := sprintf("%s (%s)", pp(bias), pp(mcse_bias))]
t3 <- dcast(x, method + vlab ~ wlab, value.var = "cell")
setnames(t3, c("method", "vlab"), c("Method", "Physician variant"))
knitr::kable(t3[order(-as.integer(Method))], caption = paste(
  "Table 3. Estimation bias (MCSE) against each method's own truth, percentage points.",
  "Harm scenario, disease composite."))
```

```{r tab3b}
x[, cell2 := pp(total)]
t3b <- dcast(x, method + vlab ~ wlab, value.var = "cell2")
setnames(t3b, c("method", "vlab"), c("Method", "Physician variant"))
knitr::kable(t3b[order(-as.integer(Method))], caption = paste(
  "Table 3b. Total error against the reference truth (CCW A vs B1), percentage points.",
  "Harm scenario, disease composite."))
```

**What it shows.**

* **Surgeon skill (W1).** CCW and sequential trials stay within about 1 pp, and the FE variant brings
  them to 0.2–0.3 pp. The **landmark is badly off (total error about 14–16 pp)**. Almost all of that is
  question gap, not estimation bias, and Section 6 (Q1) explains why.
* **Practice style (W2).** It only harms the **naive** design (bias −9 to −12 pp). The TTE designs
  absorb style through their time-varying PVI models.
* **Style that also changes the outcome coding (W3).** It biases landmark and sequential trials by
  about 1.5 pp when the physician is ignored. A random intercept or FE removes most of it, which
  supports H2b.
* **Deferral / crossover (W4).** No design bias. The TTE designs handle crossover by design.
* **Unmeasured severity (W5).** It biases **every** observational design by about 2.5–5.5 pp, and no
  physician variant helps (H2c holds).
* **Realistic world (WR).** CCW is biased by +6 to +7 pp and sequential trials by +7 to +9 pp. FE helps
  only a little. Unmeasured severity dominates.

# 3. False alarms under the null (headline for clinicians)

```{r fig2, fig.width = 10, fig.height = 5.2}
fa <- perf[scenario == "null" & outcome == "disease" & analysis == "main" & key != "ccw|A_B2" & variant != "V1_ignore"]
fa[, row := factor(paste0(method, " · ", sub(" \\(.*", "", vlab)))]
fa[, row := factor(row, levels = rev(sort(levels(row))))]
p1 <- ggplot(fa, aes(wlab, row, fill = 100 * reject0)) + geom_tile(colour = "white", linewidth = 1) +
  geom_text(aes(label = sprintf("%.0f", 100 * reject0), colour = reject0 > 0.5), size = 3) +
  scale_colour_manual(values = c(`TRUE` = "white", `FALSE` = "#0b0b0b"), guide = "none") +
  scale_fill_gradient(low = "#eef4fc", high = "#0d3d78", limits = c(0, 100), name = "% of replicates\nCI excludes 0") +
  labs(x = NULL, y = NULL, title = "Figure 2. False-alarm rate, null scenario (disease composite; nominal 5%)") +
  theme(axis.text.x = element_text(angle = 30, hjust = 1), panel.grid = element_blank(), legend.position = "right")
p1
```

```{r fig2b, fig.width = 8, fig.height = 3}
m0 <- perf[scenario == "null" & world == "W0" & variant %in% c("V2_cluster", "none") &
             outcome %in% c("male", "disease") & !grepl("as_treated", key) & key != "ccw|A_B2"]
m0[, oc := factor(ifelse(outcome == "male", "MALE", "Disease composite"), levels = c("Disease composite", "MALE"))]
ggplot(m0, aes(100 * mean_est, method, colour = oc, group = oc)) +
  geom_vline(xintercept = 0, colour = "#c3c2b7") +
  geom_errorbarh(aes(xmin = 100 * (mean_est - 1.96 * emp_se), xmax = 100 * (mean_est + 1.96 * emp_se)), height = 0, linewidth = 0.6, position = position_dodge(width = 0.5)) +
  geom_point(size = 2, position = position_dodge(width = 0.5)) + scale_colour_manual(values = c("Disease composite" = "#2a78d6", MALE = "#eb6834"), name = NULL) +
  labs(x = "Risk difference (pp), W0 null", y = NULL,
       title = "Figure 2 inset. Sharp null: disease 0, yet MALE about +14 pp")
```

**What it shows.**

* In the clean, skill and deferral worlds, landmark, sequential trials and naive are near 5%. **CCW
  is at 10–15% in W0/W1**, mainly because its SE is slightly underestimated in the null scenario
  (model/empirical SE 0.86 in W0) and its estimate sits slightly low (−0.33 pp, 1.3 MCSE). The
  bootstrap check (D28) is meant to settle this.
* Style that changes outcome coding (W3) pushes naive to 51–55% and sequential trials to 25% when the
  physician is ignored. A random intercept or FE brings that back to 8–16%.
* Unmeasured severity (W5, WR) gives **80–100% false alarms** for landmark, sequential trials and
  naive. CCW stays at 15–24%, but only because its SE is wide. FE lowers the landmark and sequential
  rates in WR (31% and 60%).
* **MALE under the sharp null:** +14 pp for CCW, purely because only treated patients can have a
  repeat revascularization. Every design "detects harm" on MALE in 93–100% of replicates.

# 4. Aim 3: do negative controls detect bias?

```{r tab4}
s <- ncs[level == "cell"]
s[, cell := ifelse(is.na(sens), "–", sprintf("%.0f%% / %s", 100 * sens, ifelse(is.na(spec), "–", sprintf("%.0f%%", 100 * spec))))]
s[, control := factor(c(nco1 = "NCO-1 (hip fracture / pneumonia)", nco2 = "NCO-2 (vein ablation)",
                        nce = "NCE (early low-value procedure)", any_nc = "Any of the three")[control],
                      levels = c("NCO-1 (hip fracture / pneumonia)", "NCO-2 (vein ablation)",
                                 "NCE (early low-value procedure)", "Any of the three"))]
s[, wl := factor(c(WLAB, all = "All worlds")[world], levels = c(WLAB[WORLDS], "All worlds"))]
knitr::kable(dcast(s, control ~ wl, value.var = "cell"), caption = paste(
  "Table 4. Sensitivity / specificity of each negative control for MALE bias > 1 pp.",
  "A cell (world × scenario × method × variant) counts as biased when its mean MALE bias exceeds 1 pp;",
  "a replicate is flagged when the control's 95% CI excludes 0. '–': no biased (or no clean) cells in that world."))
```

```{r fig3, fig.width = 10, fig.height = 4.5}
nc[, design_lab := factor(c(ccw = "CCW", seq = "Sequential", landmark = "Landmark", naive = "Naive")[design],
                          levels = c("CCW", "Sequential", "Landmark", "Naive"))]
nc[, flag := factor(ifelse(any_nc, "A negative control flagged", "All negative controls clean"),
                    levels = c("All negative controls clean", "A negative control flagged"))]
nc[, wlab := factor(WLAB[world], levels = WLAB[WORLDS])]
cb <- nc[, .(absbias = abs(mean(err))), by = .(world, wlab, scenario, design_lab, variant, flag)]
ggplot(cb, aes(wlab, 100 * absbias, colour = flag)) +
  geom_point(position = position_jitterdodge(jitter.width = 0.15, dodge.width = 0.6), size = 1.4, alpha = 0.8) +
  geom_hline(yintercept = 1, linetype = 2, colour = "#52514e") +
  scale_colour_manual(values = c("All negative controls clean" = "#1baf7a", "A negative control flagged" = "#eb6834"), name = NULL) +
  facet_wrap(~design_lab, nrow = 1) +
  labs(x = NULL, y = "|mean MALE bias| (pp)", title = "Figure 3. How much bias sits behind a clean negative control") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
```

**What it shows (provisional, see Q2).**

* **NCO-1 almost never flags (sensitivity about 12%), even with unmeasured severity (W5).** In the
  current DGP, NCO-1 depends on frailty, smoking and age but **not on claudication severity**, so it
  cannot see the main source of bias. H3a fails, by construction.
* **NCO-2 is the working detector (48% sensitivity overall, 65–67% in WR).** It also fires when style
  does no harm (specificity 26–45% in W2/W3), which supports H3b.
* **The NCE almost never flags (about 5–9%).** It is adjusted for early PVI (D36), and it shares style
  and frailty, not severity.
* **Bias hides behind clean controls.** In WR, the cells with clean negative controls still have a
  median |MALE bias| of 8.5 pp (H3c).

# 5. Simulated RCTs

```{r tabrct}
r <- perf[analysis == "rct" & outcome == "disease" & scenario != "null"]
r <- r[, .(World = wlab, Scenario = scenario, Trial = method, `Reference` = pp(ref), `Own ITT truth` = pp(own),
           `Mean estimate` = pp(mean_est), `Empirical SE` = pp(emp_se), `Power (CI excludes 0)` = sprintf("%.0f%%", 100 * reject0))]
knitr::kable(r[order(World, Scenario, Trial)], caption = "Table 5. Simulated trials, disease composite (pp).")
```

* **Surgeon selection changes the answer.** In WR, a realistic trial recruits hospital-based,
  top-third-skill, low-style surgeons. Its own ITT truth is **+2.1 pp under harm and −1.4 pp under
  benefit-then-harm**, while the population effects are +6.9 and +7.7. A well-run trial answers a
  question about selected surgeons (H1c).
* **Small trials are uninformative.** With n = 240 the SE is about 4 pp, giving 6–29% power against
  effects of 5–8 pp.
* The ideal pragmatic RCT (n = 50,000) recovers its truth with an SE of about 0.3–0.6 pp.

# 6. Open questions raised by the draft run

**Q1. Landmark adjusts for severity at month 5, after the PVI.** As specified in D13, the landmark
propensity model uses covariates at diagnosis **and at month W−1**. For treated patients, month-5
severity is already changed by the PVI (relief, then faster progression), so it is a mediator.
Conditioning on it gives extreme weights (effective treated sample about 110–140) and a large own-truth
shift when the harm varies between patients (W1: own truth about 20 pp vs a reference of 7 pp).
A check on 20 oracle replicates gave these landmark estimates:

| World (harm) | Adjust for month-5 severity | Baseline covariates only | Reference |
|---|---|---|---|
| W0 | 8.6 (SD 3.4) | 5.6 (SD 1.4) | 5.1 |
| W1 | 14.6 (SD 4.3) | 8.1 (SD 1.6) | 7.2 |

**Q2. NCO-1 does not depend on severity.** D32 says NCO-1 "shares the latent patient frailty,
severity and smoking", but the DGP's NCO-1 model has no severity term. That is why it misses the
W5/WR bias.

**Also pending:** the physician-cluster bootstrap check of SEs (D28). Model-to-empirical SE ratios
are near 1 for CCW (0.96–1.07, except WR 0.87). They are 0.83–0.92 for landmark and sequential trials
in W0, and 0.58 for landmark in W1.

# Supplement: full performance table

```{r supp}
x <- perf[analysis == "main" & outcome %in% c("disease", "male")]
knitr::kable(x[order(outcome, scenario, world, method, variant),
  .(outcome, scenario, world, method = as.character(method), variant, est = pp(mean_est, 2), own = pp(own, 2),
    ref = pp(ref, 2), bias = pp(bias, 2), mcse = pp(mcse_bias, 2), gap = pp(gap, 2), emp_se = pp(emp_se, 2),
    se_ratio = round(se_ratio, 2), cover = round(cover_own, 2), reject0 = round(reject0, 2))])
```