chendun1995/tte-surgery
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Truths, estimators (naive, landmark, CCW, sequential; physician variants V1-V4) and simulated RCTs

Browse Source 
- truths.R: interventional truths by common random numbers (A, B1, B2, sequential ITT)
- estimators.R: weighted Aalen-Johansen with influence-function SEs (patient / physician cluster)
- rct.R: realistic and ideal trials, ITT and as-treated; RCT ITT truths
- scenario effects tuned in W0: harm +5.1 pp, benefit-then-harm -1.2 pp at 24 mo, +3.1 at 60

Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
chendun1995
2026-10-27 09:01:13 -04:00
co-authored by Claude Opus 5.5
parent 5ae8874693
commit fc1461d5b5
8 changed files with 566 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
pvisim/R/simulate.R
+9 -5
View File
@@ -72,12 +72,16 @@ make_population <- function(par, n = par$size$n_patients, seed = 1L, phys = NULL
# B2 no elective PVI ever
# seq_force / seq_forbid (m) natural except PVI forced / forbidden at month m
policy <- function(type = "natural", m = NA_integer_) {
stopifnot(type %in% c("natural", "A", "B1", "B2", "seq_force", "seq_forbid"))
list(type = type, m = m)
# custom pol$decide(t, natural, idx): idx are the eligible patients' row
# numbers, so the decision can differ by patient (simulated RCTs)
policy <- function(type = "natural", m = NA_integer_, decide = NULL) {
stopifnot(type %in% c("natural", "A", "B1", "B2", "seq_force", "seq_forbid", "custom"))
list(type = type, m = m, decide = decide)
}
apply_policy <- function(pol, t, natural, window) {
apply_policy <- function(pol, t, natural, window, idx = NULL) {
if (pol$type == "custom") return(pol$decide(t, natural, idx))
switch(pol$type,
natural = natural,
A = if (t < window - 1) natural else if (t == window - 1) rep(TRUE, length(natural)) else natural,
@@ -196,7 +200,7 @@ simulate_course <- function(pop, par, pol = policy("natural"), seed = 1L, record
if (any(elig)) {
lp <- if (t < W) lp_win[elig] + tr$window$z * Z[elig] else lp_def[elig] + tr$deferred$z * Z[elig]
natural <- U[elig, "pvi"] < plogis(lp)
go <- apply_policy(pol, t, natural, W)
go <- apply_policy(pol, t, natural, W, which(elig))
idx <- which(elig)[go]
if (length(idx)) {
treated[idx] <- TRUE; t_pvi[idx] <- t; pvi_elective[idx] <- TRUE