如何生成協變量調整的 cox 生存/危險函數？

Question

我正在使用survminer package 嘗試為具有 5 個感興趣子組的縱向學生級數據集生成生存和危險 function 圖。

我已經成功創建了一個 model，它顯示了生存函數，而無需使用ggsurvplot調整學生級別的協變量。

ggsurvplot(survfit(Surv(expectedgr, sped) ~ langstatus_new, data=mydata), pvalue=TRUE)

Output 示例

但是，我無法設法針對協變量調整這些曲線。 我的目標是創建這樣的圖表。 如您所見，這些是根據某些因子變量進行協變量調整的生存曲線。 有誰可以在R中獲得此類圖表？

Answer 1

您希望從 Cox model 獲得某些感興趣協變量的某些值的生存概率，同時調整其他協變量。 但是，由於我們沒有對 Cox model 中的生存時間分布做出任何假設，因此我們無法直接從中獲得生存概率。 我們首先必須估計基線危險 function，這通常使用非參數 Breslow 估計器完成。 當 Cox coxph配備來自survival package 的 coxph 時，我們可以通過調用survfit() ZC1C425268E68385D14AB5074C17A94 來獲得這樣的概率。 您可以咨詢?survfit.coxph了解更多信息。

讓我們看看如何通過使用lung數據集來做到這一點。

library(survival)

# select covariates of interest
df <- subset(lung, select = c(time, status, age, sex, ph.karno))

# assess whether there are any missing observations
apply(df, 2, \(x) sum(is.na(x))) # 1 in ph.karno

# listwise delete missing observations
df <- df[complete.cases(df), ]

# Cox model
fit <- coxph(Surv(time, status == 2) ~ age + sex + ph.karno, data = df)

## Note that I ignore the fact that ph.karno does not satisfy the PH assumption.

# specify for which combinations of values of age, sex, and 
# ph.karno we want to derive survival probabilies
ND <- with(df, expand.grid(
  age = median(age),
  sex = c(1,2),
  ph.karno = median(ph.karno)
))

# Obtain the expected survival times
sfit <- survfit(fit, newdata = ND)

output sfit包含ND中指定的協變量組合的預期中位生存時間和相應的 95% 置信區間。

> sfit
Call: survfit(formula = fit, newdata = ND)

    n events median 0.95LCL 0.95UCL
1 227    164    283     223     329
2 227    164    371     320     524

使用summary()方法的times參數獲得特定后續時間的生存概率。

# survival probabilities at 200 days of follow-up
summary(sfit, times = 200)

output 再次包含預期生存概率，但現在是在 200 天的隨訪之后，其中survival1 1 對應於第一行ND的預期生存概率，即中位age的男性， ph.karno中位值。

> summary(sfit, times = 200)
Call: survfit(formula = fit, newdata = ND)

 time n.risk n.event survival1 survival2
  200    144      71     0.625     0.751

可以從summary()中手動提取與這兩個概率相關的 95% 置信限。

sum_sfit <- summary(sfit, times = 200)
sum_sfit <- t(rbind(sum_sfit$surv, sum_sfit$lower, sum_sfit$upper))
colnames(sum_sfit) <- c("S_hat", "2.5 %", "97.5 %")
# ------------------------------------------------------
> sum_sfit
      S_hat     2.5 %    97.5 %
1 0.6250586 0.5541646 0.7050220
2 0.7513961 0.6842830 0.8250914

如果您想使用ggplot來描述這兩個人的預期生存概率（以及相應的 95% 置信區間），我們首先需要制作一個data.frame ，其中包含適當格式的所有信息。

# create data frame which can be passed to ggplot
df1 <- data.frame(
  time    = sfit$time,
  n.risk  = sfit$n.risk,
  n.event = sfit$n.event,
  surv    = sfit$surv[, 1],
  upper   = sfit$upper[, 1],
  lower   = sfit$lower[, 1]
)
df2 <- data.frame(
  time    = sfit$time,
  n.risk  = sfit$n.risk,
  n.event = sfit$n.event,
  surv    = sfit$surv[, 2],
  upper   = sfit$upper[, 2],
  lower   = sfit$lower[, 2]
)
df <- rbind(df1, df2)
df$sex <- gl(2, nrow(df1), labels = c('Males', 'Females'))

現在我們已經定義了data.frame ，我們需要定義一個新的 function 到 plot 95% CI，我們通常稱之為geom_stepribbon 。

library(ggplot2)

# Function for geom_stepribbon
geom_stepribbon <- function(
  mapping     = NULL,
  data        = NULL,
  stat        = "identity",
  position    = "identity",
  na.rm       = FALSE,
  show.legend = NA,
  inherit.aes = TRUE, ...) {
  layer(
    data        = data,
    mapping     = mapping,
    stat        = stat,
    geom        = GeomStepribbon,
    position    = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params      = list(na.rm = na.rm, ... )
  )
}

GeomStepribbon <- ggproto(
  "GeomStepribbon", GeomRibbon,
  extra_params = c("na.rm"),
  draw_group = function(data, panel_scales, coord, na.rm = FALSE) {
    if (na.rm) data <- data[complete.cases(data[c("x", "ymin", "ymax")]), ]
    data   <- rbind(data, data)
    data   <- data[order(data$x), ]
    data$x <- c(data$x[2:nrow(data)], NA)
    data   <- data[complete.cases(data["x"]), ]
    GeomRibbon$draw_group(data, panel_scales, coord, na.rm = FALSE)
  }
)

最后，我們可以 plot 我們兩個示例個體的預期生存概率。 請注意，這些是中位age和中位ph.karno的男性和女性患者的預期生存概率。

yl <- 'Expected Survival probability\n'
xl <- '\nTime (days)'
my_colours <- c('blue4', 'darkorange')
adj_colour <- \(x) adjustcolor(x, alpha.f = 0.2)
my_colours <- c(
  my_colours, adj_colour(my_colours[1]), adj_colour(my_colours[2])
)
ggplot(df, aes(x = time, colour = sex, fill = sex)) + 
  geom_step(aes(y = surv), size = 0.8) + 
  geom_stepribbon(aes(ymin = lower, ymax = upper), colour = NA) +
  scale_colour_manual(name = 'Sex',
                      values = c('Males' = my_colours[1],
                                 'Females' = my_colours[2])) +
  scale_fill_manual(name = 'Sex',
                    values = c('Males' = my_colours[3],
                               'Females' = my_colours[4])) +
  ylab(yl) + xlab(xl) +
  theme(axis.text = element_text(size = 12),
        axis.title = element_text(size = 12),
        legend.text = element_text(size = 12),
        legend.title = element_text(size = 12))

Output

這些生存曲線將始終滿足 PH 假設，因為它們來自 Cox model。

注意：如果您使用 R <4.1.0 的版本，請使用function(x)而不是\(x)

Answer 2

盡管正確，但我相信 Dion Groothof 的回答中描述的方法通常不是人們感興趣的方法。 通常，研究人員有興趣可視化針對混雜因素調整的變量的因果效應。 簡單地顯示一個單一協變量組合的預測生存曲線在這里並不能真正起到作用。 我建議閱讀混雜因素調整后的生存曲線。 例如，參見https://arxiv.org/abs/2203.10002 。

這些類型的曲線可以在 R 中使用adjustedCurves package 計算： https://github.com/RobinDenz1/adjustedCurves

在您的示例中，可以使用以下代碼：

library(survival)
library(devtools)

# install adjustedCurves from github, load it
devtools::install_github("/RobinDenz1/adjustedCurves")
library(adjustedCurves)

# "event" needs to be binary
lung$status <- lung$status - 1

# "variable" needs to be a factor
lung$ph.ecog <- factor(lung$ph.ecog)

fit <- coxph(Surv(time, status) ~  ph.ecog + age + sex, data=lung,
             x=TRUE)

# calculate and plot curves
adj <- adjustedsurv(data=lung, variable="ph.ecog", ev_time="time",
                    event="status", method="direct",
                    outcome_model=fit, conf_int=TRUE)
plot(adj)

產生以下 output：

這些生存曲線針對age和sex的影響進行了調整。 有關此調整如何工作的更多信息，請參閱adjustedCurves package 的文檔或我上面引用的文章。