chendun1995andClaude Opus 5.5
5c4407f876
- latent-severity DGP with physicians (skill, style), policies A/B1/B2/sequential, common random numbers - sharp null exact at the patient level (tested) - 01_calibrate.R: joint logit-scale update; all worlds match early PVI 3.2%, late PVI 22.5/3.6%, CLTI 7.8%, death 35% - W4 deferral target 15% (trial-like crossover); post-CLTI PVI lowered so late PVI is mostly elective Co-Authored-By: Claude Opus 5.5 <[email protected]>
27 lines
1.9 KiB
R
27 lines
1.9 KiB
R
# Quick look: the natural course of each world against the calibration targets (plan 5.4).
|
|
pkgload::load_all("pvisim", quiet = TRUE)
|
|
library(data.table)
|
|
args <- commandArgs(TRUE); worlds <- if (length(args)) args else c("W0", "WR")
|
|
for (w in worlds) {
|
|
par <- load_params(w, "harm")
|
|
t0 <- Sys.time()
|
|
pop <- make_population(par, seed = 1L)
|
|
ev <- simulate_course(pop, par, policy("natural"), seed = 2L, record = FALSE)$events
|
|
ev <- merge(ev, pop$pat[, .(id, phys_id)], by = "id")
|
|
early <- !is.na(ev$t_pvi) & ev$t_pvi < 6 & ev$pvi_elective %in% TRUE
|
|
h <- 53 # Sorber median follow-up about 4.4 years
|
|
late <- !is.na(ev$t_pvi) & ev$t_pvi >= 6 | !is.na(ev$t_rr) & ev$t_rr >= 6
|
|
late <- late & pmin(ev$t_pvi * NA^(ev$t_pvi < 6), ifelse(!is.na(ev$t_rr) & ev$t_rr >= 6, ev$t_rr, NA), na.rm = TRUE) < h
|
|
clti <- !is.na(ev$t_clti_code) & ev$t_clti_code < h
|
|
phys <- ev[, .(n = .N, rate = mean(!is.na(t_pvi) & t_pvi < 6 & pvi_elective %in% TRUE)), by = phys_id]
|
|
sdr <- sd(phys$rate); out <- mean(phys$rate >= mean(phys$rate) + 2 * sdr)
|
|
cat(sprintf("\n%s (%.0fs)\n early PVI %.1f%% (target 3.2)\n physician rate: median %.1f%%, max %.0f%%, >=2SD outliers %.1f%% (0, 58, 5.6)\n",
|
|
w, as.numeric(Sys.time() - t0, units = "secs"), 100 * mean(early),
|
|
100 * median(phys$rate), 100 * max(phys$rate), 100 * out))
|
|
cat(sprintf(" late PVI by 4.4y: early %.1f%% vs not %.1f%% (22.5 vs 3.6)\n", 100 * mean(late[early]), 100 * mean(late[!early])))
|
|
cat(sprintf(" coded CLTI by 4.4y: early %.1f%% vs not %.1f%% (16.4 vs 7.8)\n", 100 * mean(clti[early]), 100 * mean(clti[!early])))
|
|
cat(sprintf(" death by 5y %.1f%% (about 35) MALE by 5y %.1f%% amputation %.2f%% disease composite %.1f%%\n",
|
|
100 * cum_inc(ev$t_death), 100 * cum_inc(ev$t_male), 100 * cum_inc(ev$t_amp), 100 * cum_inc(ev$t_disease)))
|
|
cat(sprintf(" NCO1 %.1f%% NCO2 %.1f%% NCE %.1f%%\n", 100 * cum_inc(ev$t_nco1), 100 * cum_inc(ev$t_nco2), 100 * cum_inc(ev$t_nce)))
|
|
}
|