繪制ggplot中連續協變量的預測生存曲線

Question

如何在cox比例風險模型中繪制連續協變量代表值的生存曲線？ 具體來說，我想在ggplot中使用“survfit.cox”“survfit”對象執行此操作。

這可能看起來像是一個已經回答的問題，但我已經搜索了SO中的所有內容，其中包括“survfit”和“newdata”（加上許多其他搜索詞）。 到目前為止，這是最接近回答我的問題的線索： 為Cox回歸繪制Kaplan-Meier

與該帖子的一個答案中提供的可重現的示例保持一致：

url <- "http://socserv.mcmaster.ca/jfox/Books/Companion/data/Rossi.txt"
df <- read.table(url, header = TRUE)

library(dplyr)
library(ggplot2)
library(survival)
library(magrittr)
library(broom)

# Identifying the 25th and 75th percentiles for prio (continuous covariate)

summary(df$prio)

# Cox proportional hazards model with other covariates
# 'prio' is our explanatory variable of interest

m1 <- coxph(Surv(week, arrest) ~ 
                       fin + age + race + prio,
                     data = df)

# Creating new df to get survival predictions
# Want separate curves for the the different 'fin' and 'race'
# groups as well as the 25th and 75th percentile of prio

newdf <- df %$%
  expand.grid(fin = levels(fin), 
                    age = 30, 
                    race = levels(race), 
                    prio = c(1,4))

# Obtain the fitted survival curve, then tidy 
# into a dataframe that can be used in ggplot

survcurv <- survfit(m1, newdata = newdf) %>%
  tidy()

問題是，一旦我有了這個名為survcurv數據幀，我無法分辨哪個'估計'變量屬於哪個模式，因為沒有保留原始變量。 例如，哪個'估計'變量代表30歲的擬合曲線，種族='其他'，prio ='4'，fin ='no'？

在我見過的所有其他示例中，通常將一個幸存對象放入一個通用的plot()函數中，並且不添加圖例。 我想使用ggplot並為每個預測曲線添加一個圖例。

在我自己的數據集中，模型要復雜得多，並且曲線比我在這里顯示的要多得多，所以你可以想象看到40個不同的'estimate.1'。'估計.40'變量使得它很難理解什么是什么。

Answer 1

感謝您提供一個措辭嚴謹的問題和一個很好的例子。 我有點驚訝， tidy在這里創造合理的產出相對較差。 請參閱下面的我嘗試創建一些可繪制的數據：

library(tidyr)
newdf$group <- as.character(1:nrow(newdf))

survcurv <- survfit(m1, newdata = newdf) %>%
  tidy() %>% 
  gather('key', 'value', -time, -n.risk, -n.event, -n.censor) %>% 
  mutate(group = substr(key, nchar(key), nchar(key)),
         key   = substr(key, 1, nchar(key) - 2)) %>% 
  left_join(newdf, 'group') %>% 
  spread(key, value)

並創建一個情節（也許你想使用geom_step代替，但不幸的是沒有階梯狀的功能區）：

ggplot(survcurv, aes(x = time, y = estimate, ymin = conf.low, ymax = conf.high,
                     col = race, fill = race)) +
  geom_line(size = 1) +
  geom_ribbon(alpha = 0.2, col = NA) +
  facet_grid(prio ~ fin)

Answer 2

嘗試像這樣定義你的survcurv ：

survcurv <- 
  lapply(1:nrow(newdf),
         function(x, m1, newdata){
           cbind(newdata[x, ], survfit(m1, newdata[x, ]) %>% tidy)
         },
         m1, 
         newdf) %>%
  bind_rows()

這將包括所有預測值作為具有預測估計的列。