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

D53: landmark on baseline covariates (month-5 version as landmark_m5), NCO-1 depends on PVI-free severity, physician-cluster bootstrap script

Browse Source 
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
chendun1995
2026-10-28 07:20:32 -04:00
co-authored by Claude Opus 5.5
parent fbc417662c
commit 5304c89316
10 changed files with 86 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
pvisim/R/simulate.R
+8 -3
View File
@@ -127,12 +127,14 @@ simulate_course <- function(pop, par, pol = policy("natural"), seed = 1L, record
lp_rr0 <- rr$intercept + rr$skill * pat$skill + rr$style * pat$style
lp_nco1 <- nc$nco1$intercept + nc$nco1$frailty * pat$frailty + nc$nco1$smoking * pat$smoking_true +
nc$nco1$age10 * a10
nco1_z <- if (is.null(nc$nco1$z)) 0 else nc$nco1$z
lp_nco2 <- nc$nco2$intercept + nc$nco2$style * pat$style + nc$nco2$venous * pat$venous
lp_nce <- nc$nce$intercept + nc$nce$style * pat$style + nc$nce$frailty * pat$frailty
kappa_post <- ef$kappa * exp(-ef$skill_kappa * pat$skill)
# state
Z <- pat$z0
Zn <- pat$z0 # severity on the natural course without any PVI (relief or kappa): drives NCO-1 (D53)
alive <- rep(TRUE, N); treated <- rep(FALSE, N); clti_true <- rep(FALSE, N)
clti_code <- rep(FALSE, N); male <- rep(FALSE, N)
t_pvi <- t_clti_true <- t_clti_code <- t_amp <- t_bypass <- t_rr <- t_male <- t_death <-
@@ -147,8 +149,11 @@ simulate_course <- function(pop, par, pol = policy("natural"), seed = 1L, record
for (t in 0:(M - 1)) {
U <- matrix(runif(N * ns), N, ns, dimnames = list(NULL, STREAMS))
a <- alive
if (t > 0) Z[a] <- Z[a] + pat$rate[a] + kappa_post[a] * treated[a] +
par$severity$eps_sd * qnorm(U[a, "eps"])
if (t > 0) {
eps <- par$severity$eps_sd * qnorm(U[a, "eps"])
Z[a] <- Z[a] + pat$rate[a] + kappa_post[a] * treated[a] + eps
Zn[a] <- Zn[a] + pat$rate[a] + eps
}
if (record) {
zmat[a, t + 1] <- Z[a]
cmat[a, t + 1] <- qpois(U[a, "proxy"], exp(par$measurement$proxy_intercept + par$measurement$proxy_z * Z[a]))
@@ -183,7 +188,7 @@ simulate_course <- function(pop, par, pol = policy("natural"), seed = 1L, record
}
# negative controls (never depend on PVI)
x <- a & is.na(t_nco1) & U[, "nco1"] < plogis(lp_nco1); t_nco1[x] <- t
x <- a & is.na(t_nco1) & U[, "nco1"] < plogis(lp_nco1 + nco1_z * Zn); t_nco1[x] <- t
x <- a & is.na(t_nco2) & U[, "nco2"] < plogis(lp_nco2); t_nco2[x] <- t
if (t < W) { x <- a & is.na(t_nce) & U[, "nce"] < plogis(lp_nce); t_nce[x] <- t }