288 lines
18 KiB
Plaintext
288 lines
18 KiB
Plaintext
---
|
||
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))])
|
||
```
|