与ggsurvplot合并两个Kaplan Meier曲线

如何解决与ggsurvplot合并两个Kaplan Meier曲线

我有两个不同的数据集，基本上都包含相同的数据，但是一个用于19岁或以下的基线年龄（data.all.agefs.under19），另一个用于19岁以上的年龄（data.all.agefs.above19）

每个对象的生存对象定义为：

surv.all.agefs.under19 <- Surv(time = data.all.agefs.under19$follow.up.years,event = data.all.agefs.under19$death.specific)
surv.all.agefs.above19 <- Surv(time = data.all.agefs.above19$follow.up.years,event = data.all.agefs.above19$death.specific)

Cox PH模型定义为：

cox.all.agefs.under19 <- coxph(surv.all.agefs.under19 ~ factor1 + factor2 + factor3,data = data.all.agefs.under19)
cox.all.agefs.above19 <- coxph(surv.all.agefs.above19 ~ factor1 + factor2 + factor3,data = data.all.agefs.above19)

我想为两者创建一个都有Kaplan Meier曲线的图，但是到目前为止，我只能使用ggsurvplot为每个曲线创建一个图：

ggsurv <- ggsurvplot(survfit(cox.all.agefs.under19),data = data.all.agefs.under19,palette = "#2E9FDF",ggtheme = theme_minimal(),legend = "none")
ggsurv <- ggsurvplot(survfit(cox.all.agefs.above19),data = data.all.agefs.above19,legend = "none")

那么如何将两条曲线合并到同一图中？

解决方法

您可以将数据附加到一个较长的数据框中，并定义变量agegrp以区分两个年龄段。然后您可以如下图所示。

df1 <- lung
df1$agegrp <- df1$sex

fitme <- survfit(Surv(time,status) ~ agegrp,data = df1) 

  ggsurv2 <- plot(fitme,xlim = c(0,1200),main = "Survival curves based on Kaplan-Meier estimates",xlab = "Time in days",# customize   X axis label.
                  ylab = "Overall survival probability"  # Y axis label
  )
  temp <- lines(fitme,lwd=2:1,col = c("red","blue"))
  text(temp,c("Under19","Above19"),adj= -.1) # labels just past the ends
  

更新：

如下所示使用ggsurvplot

ggsurv <- ggsurvplot(
    fitme,# survfit object with calculated statistics.
    data = df1,# data used to fit survival curves.
    risk.table = TRUE,# show risk table.
    pval = TRUE,# show p-value of log-rank test.
    conf.int = TRUE,# show confidence intervals for
    # point estimates of survival curves.
    palette = c("#E7B800","#2E9FDF"),# present narrower X axis,but not affect
    # survival estimates.
    xlab = "Time in days",# customize X axis label.
    break.time.by = 100,# break X axis in time intervals by 500.
    ggtheme = theme_light(),# customize plot and risk table with a theme.
    risk.table.y.text.col = T,# colour risk table text annotations.
    risk.table.height = 0.25,# the height of the risk table
    risk.table.y.text = FALSE,# show bars instead of names in text annotations
    # in legend of risk table.
    ncensor.plot = TRUE,# plot the number of censored subjects at time t
    ncensor.plot.height = 0.25,conf.int.style = "step",# customize style of confidence intervals
    surv.median.line = "hv",# add the median survival pointer.
    legend.labs = c("Under19","Above19")  # change legend labels.
  )

,

还有另一种可能的方式，也在 survminer 包中：

colnames(data.all.agefs.under19) <- paste0(colnames(data.all.agefs.under19),"_u19")
colnames(data.all.agefs.above19) <- paste0(colnames(data.all.agefs.above19),"_a19")

data.all.agefs <- cbind(data.all.agefs.under19,data.all.agefs.above19)

ggsurvplot_combine(list(under19 = survfit(Surv(follow.up.years_u19,death.specific_u19) ~ factor1_u19 + factor2_u19 + factor3_u19,data = data.all.agefs),above19 = survfit(Surv(follow.up.years_a19,death.specific_a19) ~ factor1_a19 + factor2_a19 + factor3_a19,data = data.all.agefs)),data = data.all.agefs)