D56: limb MALE (CLTI, major amputation, open bypass) as primary outcome; MALE incl. repeat revascularization to supplement
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
+18
-18
@@ -52,7 +52,7 @@ perf[, vlab := factor(VAR[variant], levels = VAR)]
|
||||
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)**,
|
||||
* **Outcome shown.** The headline outcome is **limb MALE (CLTI, major amputation or open bypass; D56)**,
|
||||
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.
|
||||
@@ -64,7 +64,7 @@ perf[, vlab := factor(VAR[variant], levels = VAR)]
|
||||
# 1. Aim 1: what each method answers (clean world W0)
|
||||
|
||||
```{r tab2}
|
||||
t2 <- perf[world == "W0" & outcome == "disease" & variant %in% c("V2_cluster", "none") &
|
||||
t2 <- perf[world == "W0" & outcome == "limb" & 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),
|
||||
@@ -89,7 +89,7 @@ knitr::kable(t2[order(Scenario, Method)], align = "llrrrrrrr",
|
||||
the 5-point harm in only 25% of replicates.
|
||||
|
||||
```{r fig1, fig.width = 11, fig.height = 9}
|
||||
ladder <- function(sc, oc = "disease") {
|
||||
ladder <- function(sc, oc = "limb") {
|
||||
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)]
|
||||
@@ -109,24 +109,24 @@ ladder <- function(sc, oc = "disease") {
|
||||
"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)")
|
||||
ladder("harm") + ggtitle("Figure 1a. Estimand ladder, harm scenario (limb MALE)")
|
||||
```
|
||||
|
||||
```{r fig1b, fig.width = 11, fig.height = 9}
|
||||
ladder("null") + ggtitle("Figure 1b. Estimand ladder, null scenario (disease composite)")
|
||||
ladder("null") + ggtitle("Figure 1b. Estimand ladder, null scenario (limb MALE)")
|
||||
```
|
||||
|
||||
# 2. Aim 2: surgery-specific threats
|
||||
|
||||
```{r tab3}
|
||||
x <- perf[scenario == "harm" & outcome == "disease" & analysis == "main" &
|
||||
x <- perf[scenario == "harm" & outcome == "limb" & 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."))
|
||||
"Harm scenario, limb MALE."))
|
||||
```
|
||||
|
||||
```{r tab3b}
|
||||
@@ -135,7 +135,7 @@ 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."))
|
||||
"Harm scenario, limb MALE."))
|
||||
```
|
||||
|
||||
**What it shows.**
|
||||
@@ -157,28 +157,28 @@ knitr::kable(t3b[order(-as.integer(Method))], caption = paste(
|
||||
# 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 <- perf[scenario == "null" & outcome == "limb" & 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%)") +
|
||||
labs(x = NULL, y = NULL, title = "Figure 2. False-alarm rate, null scenario (limb MALE; 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"))]
|
||||
outcome %in% c("male", "limb") & !grepl("as_treated", key) & key != "ccw|A_B2"]
|
||||
m0[, oc := factor(ifelse(outcome == "male", "MALE incl. repeat revascularization", "Limb MALE"), levels = c("Limb MALE", "MALE incl. repeat revascularization"))]
|
||||
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) +
|
||||
geom_point(size = 2, position = position_dodge(width = 0.5)) + scale_colour_manual(values = c("Limb MALE" = "#2a78d6", "MALE incl. repeat revascularization" = "#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")
|
||||
title = "Figure 2 inset. Sharp null: limb MALE 0, yet MALE incl. repeat revascularization about +14 pp")
|
||||
```
|
||||
|
||||
**What it shows.**
|
||||
@@ -242,10 +242,10 @@ ggplot(cb, aes(wlab, 100 * absbias, colour = flag)) +
|
||||
# 5. Simulated RCTs
|
||||
|
||||
```{r tabrct}
|
||||
r <- perf[analysis == "rct" & outcome == "disease" & scenario != "null"]
|
||||
r <- perf[analysis == "rct" & outcome == "limb" & 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).")
|
||||
knitr::kable(r[order(World, Scenario, Trial)], caption = "Table 5. Simulated trials, limb MALE (pp).")
|
||||
```
|
||||
|
||||
* **Surgeon selection changes the answer.** In WR, a realistic trial recruits hospital-based,
|
||||
@@ -291,7 +291,7 @@ if (length(bf)) {
|
||||
x <- bt[, .(reps = .N, boot = sqrt(mean(boot_se^2)), patient = sqrt(mean(se_patient^2)),
|
||||
cluster = sqrt(mean(se_cluster^2))), by = .(world, scenario, design, contrast, outcome)]
|
||||
x <- merge(x, emp, by = c("world", "scenario", "design", "contrast", "outcome"))
|
||||
x <- x[outcome == "disease" & contrast != "A_B2"]
|
||||
x <- x[outcome == "limb" & contrast != "A_B2"]
|
||||
knitr::kable(x[order(world, scenario, design), .(World = world, Scenario = scenario, Design = design,
|
||||
`Empirical SE (100 reps)` = pp(emp_se, 2), `Bootstrap SE` = pp(boot, 2), `Model SE, cluster` = pp(cluster, 2),
|
||||
`Model SE, patient` = pp(patient, 2), `Bootstrap / empirical` = round(boot / emp_se, 2),
|
||||
@@ -303,7 +303,7 @@ if (length(bf)) {
|
||||
# Supplement: full performance table
|
||||
|
||||
```{r supp}
|
||||
x <- perf[analysis == "main" & outcome %in% c("disease", "male")]
|
||||
x <- perf[analysis == "main" & outcome %in% c("limb", "male", "disease")]
|
||||
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),
|
||||
|
||||
Reference in New Issue
Block a user