my.survival.analysis <- function(dat, study.end.time = NULL) { ## Purpose: Survival Analysis of time-to-event data with missing data. Assume two groups. ## Arguments: ## dat: time-to-event data that look like (variable name is fixed): ## ## time status arm ## 9 1 1 ## 13 1 0 ## 13 0 1 ## ## The meaning of each variable is as follows: ## time: the follow-up time (numeric) for right censored data. ## status: the status indicator. 0 = right censored, 1 = event. ## arm: the group indicator for comparison. 0 = control group, 1 = treatment group. ## ## study.end.time: truncation time (the end of the time window in which to compare two groups). ## It needs to be smaller than the default value (minimum of the largest observed time in each of the two groups) ## ## Return: Survival Data Analysis Summary and Plots ## Author: Feiming Chen ## ________________________________________________ library(survival) dat <<- dat # so that "cox.zph(f2)" below works. fmla <- Surv(time, status) ~ arm # formula for survival time analysis f <- survfit(formula = fmla, data = dat) print(f) ## Simple plot of survival curves plot(f, lwd = 2, col = c("red", "blue"), mark.time = TRUE, xlab = "Time", ylab = "Survival Probability") legend("topright", legend = names(f$strata), bg = "lightyellow", col = c("red", "blue"), title = "Groups", lwd = 2) cat("\n------------------------------\nLog-Rank test for comparing two survival curves:\n") print(survdiff(fmla, dat)) cat("\n------------------------------\nSurvival Probability at Study End:\n") if (missing(study.end.time)) { study.end.time <- max(f$time) tau <- NULL } else tau <- study.end.time ans <- summary(f, times = study.end.time, extend = TRUE, rmean = study.end.time) print(ans) ## Post-test disease risk = 1 - survival.probability.at.end ## ARR (Absolute Risk Reduction) - Check the direction of the risk reduction manually! ARR <- diff(ans$surv) cat("ARR (Absolute Risk Reduction) =", round(ARR, 2), "\n") NNT <- ceiling(1 / ARR) cat("NNT (Number Needed to Treat) =", NNT, "\n") OR <- ans$surv[1] / (1 - ans$surv[1]) / (ans$surv[2] / (1 - ans$surv[2])) cat("Odds Ratio:", round(OR, 2), "\n") cat("\n------------------------------\nUsing Cox Regression Model:\n") f2 <- coxph(formula = fmla, data = dat) print(f2) cat("Hazard Ratio =", round(exp(f2$coefficients), 2), "\n") cat("\n------------------------------\nAssessing Proportional Hazards Assumptions:\n") print(cox.zph(f2)) cat("\n------------------------------\nRMST (Restricted Mean Survival Time) Analysis\n") library(survRM2) r <- rmst2(time = dat$time, status = dat$status, arm = dat$arm, tau = tau) print(r) ## plot(r, xlab = "Time", ylab = "Survival Probability") f } if (F) { # Unit Test d <- data.frame(time = aml$time, status = aml$status, arm = ifelse(aml$x == "Maintained", 1, 0)) f <- my.survival.analysis(d, study.end.time = 35) d <- survRM2::rmst2.sample.data() f <- my.survival.analysis(d, study.end.time = 10) ## cannot do it inside a function. ## make survival curve with cumulative events/incidences f <- survfit(Surv(time, status) ~ x, data = aml) library(survminer) ggsurvplot(f, data = aml, fun = "event", conf.int = TRUE, pval = TRUE, risk.table = "abs_pct", ggtheme = theme_bw(), palette = c("red", "blue"), risk.table.y.text.col = TRUE, risk.table.y.text = FALSE, ncensor.plot = TRUE) }
Call: survfit(formula = fmla, data = dat) n events median 0.95LCL 0.95UCL arm=0 12 11 23 8 NA arm=1 11 7 31 18 NA ------------------------------ Log-Rank test for comparing two survival curves: Call: survdiff(formula = fmla, data = dat) N Observed Expected (O-E)^2/E (O-E)^2/V arm=0 12 11 7.31 1.86 3.4 arm=1 11 7 10.69 1.27 3.4 Chisq= 3.4 on 1 degrees of freedom, p= 0.07 ------------------------------ Survival Probability at Study End: Call: survfit(formula = fmla, data = dat) arm=0 time n.risk n.event survival std.err lower 95% CI upper 95% CI 35.0000 2.0000 9.0000 0.1944 0.1219 0.0569 0.6642 arm=1 time n.risk n.event survival std.err lower 95% CI upper 95% CI 35.000 3.000 6.000 0.368 0.163 0.155 0.875 ARR (Absolute Risk Reduction) = 0.17 NNT (Number Needed to Treat) = 6 Odds Ratio: 0.41 ------------------------------ Using Cox Regression Model: Call: coxph(formula = fmla, data = dat) coef exp(coef) se(coef) z p arm -0.92 0.40 0.51 -1.8 0.07 Likelihood ratio test=3.4 on 1 df, p=0.066 n= 23, number of events= 18 Hazard Ratio = 0.4 ------------------------------ Assessing Proportional Hazards Assumptions: chisq df p arm 0.00788 1 0.93 GLOBAL 0.00788 1 0.93 ------------------------------ RMST (Restricted Mean Survival Time) Analysis The truncation time: tau = 35 was specified. Restricted Mean Survival Time (RMST) by arm Est. se lower .95 upper .95 RMST (arm=1) 27.057 2.906 21.361 32.753 RMST (arm=0) 20.958 3.456 14.185 27.732 Restricted Mean Time Lost (RMTL) by arm Est. se lower .95 upper .95 RMTL (arm=1) 7.943 2.906 2.247 13.639 RMTL (arm=0) 14.042 3.456 7.268 20.815 Between-group contrast Est. lower .95 upper .95 p RMST (arm=1)-(arm=0) 6.098 -2.752 14.949 0.177 RMST (arm=1)/(arm=0) 1.291 0.878 1.899 0.194 RMTL (arm=1)/(arm=0) 0.566 0.238 1.342 0.196
No comments:
Post a Comment