Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

ppc_km_overlay(): add argument for left-truncation? #290

Open
anddis opened this issue Nov 8, 2022 · 0 comments
Open

ppc_km_overlay(): add argument for left-truncation? #290

anddis opened this issue Nov 8, 2022 · 0 comments

Comments

@anddis
Copy link

anddis commented Nov 8, 2022

Summary
It would be great if ppc_km_overlay() could accomodate left-truncation when computing the Kaplan-Meier functions for the original sample and for the simulated data from the PPD, and not only right-censoring.

Would you consider adding a truncation_y (?) argument to ppc_km_overlay() to pass the left-truncation variable in the original sample to survival::Surv()?

Example
Weibull survival times, observed conditionally on truncation times.

Standard plot produced by ppc_km_overlay() together with KM estimates that take into account left-truncation (red, solid line) and true survival curve (black, dashed line) for the original sample (note that the ppc_km_overlay()'s KM curves for the simulated PPD data ignore truncation too, but the underlying simulated times via brms::posterior_predict() are conditional on the observed truncation times).

p8pfhG.md.png

library(brms)
library(survival)
library(ggplot2)

simdata <- local({
  set.seed(1901)
  N <- 1000
  y <- rweibull(N, shape = 1.2, scale = 1) 
  v <- rexp(N)
  data.frame(time = y, v = v)
})
simdata_trunc <- simdata[simdata$time >= simdata$v, ]

formula_brms <- bf(time | trunc(lb = v, ub = Inf) ~ 1,
                   family = weibull())
fit_brms <- brm(formula_brms,
                data = simdata_trunc,
                chains = 1,
                iter = 2000,
                seed = 12345,
                backend = "cmdstanr",
                refresh = 0)

set.seed(9)
pp <- posterior_predict(fit_brms, draw_ids = 1:5)
ppc <- bayesplot::ppc_km_overlay(simdata_trunc$time, pp, status_y = rep(1, nrow(simdata_trunc)))
km_trunc <- survfit(Surv(v, time, rep(1, nrow(simdata_trunc))) ~ 1, data = simdata_trunc)

ppc +
  geom_line(data = data.frame(time = km_trunc$time, surv = km_trunc$surv),
            aes(x = time, y = surv), col = "red",
            inherit.aes = FALSE, ,lwd = 1) +
  geom_function(fun = pweibull, args = list(lower.tail = FALSE, shape = 1.2, scale = 1),
                col = "black", lty = 2, inherit.aes = FALSE)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant