pvisim: parameters, simulator, claims records, tests; calibration of all worlds to Medicare targets

- 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]>
2026-10-27 08:15:18 -04:00
parent eb886d5505
commit 5c4407f876
11 changed files with 760 additions and 0 deletions
@@ -0,0 +1,69 @@
+# What the analyst sees: simulated Medicare claims (plan D17).
+# Latent quantities (Z_t, true smoking, frailty, skill, style, progression rate) never
+# leave this function except in `hidden`, which analysis code must not touch.
+
+HIDDEN_COLS <- c("skill", "style", "frailty", "fi_noise", "smoking_true", "z0", "rate", "venous", "z")
+
+#' Turn a population and its simulated course into claims-like records.
+#'
+#' @return list(patients = one row per patient: measured baseline and coded event times;
+#'   pm = person-months (id, t, sev_obs) from month 0 to death or month 59;
+#'   hidden = latent traits, for oracle analyses and checks only).
+make_records <- function(pop, course, par) {
+  pat <- pop$pat; ev <- course$events; ms <- par$measurement
+  M <- par$size$months
+  smoking <- if (isTRUE(ms$smoking) || identical(ms$smoking, "true")) pat$smoking_true else pat$smoking_coded
+  rel <- ms$frailty_reliability
+  fi <- sqrt(rel) * pat$frailty + sqrt(1 - rel) * pat$fi_noise
+
+  patients <- data.table(id = pat$id, phys_id = pat$phys_id, obl = pat$obl, age = pat$age,
+                         female = pat$female, black = pat$black, year = pat$year,
+                         diabetes = pat$diabetes, ckd = pat$ckd, chf = pat$chf, copd = pat$copd,
+                         prior_cvd = pat$prior_cvd, smoking = smoking, frailty_index = fi)
+  patients <- cbind(patients, ev[, !"id"])
+  # t_clti_true is latent: only the coded date is in claims
+  patients[, t_clti_true := NULL]
+
+  # observed severity: exact Z_t (clean worlds) or a claims proxy (world W5, WR)
+  last <- pmin(ifelse(is.na(ev$t_death), M - 1L, ev$t_death), M - 1L)
+  nrep <- last + 1L
+  id <- rep(pat$id, nrep)
+  t <- sequence(nrep) - 1L
+  idx <- cbind(id, t + 1L)
+  if (identical(ms$severity, "exact")) {
+    sev <- course$z[idx]
+  } else {
+    w <- ms$proxy_window
+    cs <- t(apply(course$counts, 1, function(x) { x[is.na(x)] <- 0L; cumsum(x) }))
+    lagged <- cbind(matrix(0, nrow(cs), w), cs)[, seq_len(M)]
+    sev <- log1p(cs[idx] - lagged[idx])
+  }
+  pm <- data.table(id = id, t = t, sev_obs = sev)
+
+  hidden <- data.table(id = pat$id, skill = pat$skill, style = pat$style, frailty = pat$frailty,
+                       smoking_true = pat$smoking_true, rate = pat$rate,
+                       t_clti_true = ev$t_clti_true)
+  list(patients = patients, pm = pm, hidden = hidden, par = par)
+}
+
+#' Stop if an analysis table carries a latent column.
+assert_no_hidden <- function(dt) {
+  bad <- intersect(names(dt), HIDDEN_COLS)
+  if (length(bad)) stop("latent columns in analysis data: ", paste(bad, collapse = ", "))
+  invisible(TRUE)
+}
+
+#' One replicate's records: population, natural course, claims view.
+simulate_records <- function(par, rep = 1L, n = par$size$n_patients) {
+  seed <- replicate_seed(par$world, par$scenario, rep)
+  pop <- make_population(par, n = n, seed = seed)
+  course <- simulate_course(pop, par, policy("natural"), seed = seed + 104729L, record = TRUE)
+  make_records(pop, course, par)
+}
+
+#' Reproducible seed for a world x scenario x replicate.
+replicate_seed <- function(world, scenario, rep) {
+  key <- paste(world, scenario, rep, sep = "|")
+  h <- sum(utf8ToInt(key) * seq_along(utf8ToInt(key))^2)
+  as.integer((h * 2654435761) %% 2147483647)
+}