Color space between two survival curves


We will here use the fill_survival_data function in the Data & Functions page.
Download ggcompetingrisks1.R

# Function
fill_survival_data <- function(fit){
  base <- rbind(data.frame(time=0, surv=1), data.frame(time=fit$time, surv=fit$surv))
  base <- rbind(base %>% mutate(surv = lag(surv)) %>% na.omit(), base)
  return(base %>% arrange(time))
}

# Or you can source the ggcompetingrisks1.R file
# source("ggcompetingrisks1.R", encoding="latin1")


# Libraries
library(survminer)
library(survival)
library(tidyverse)
library(zoo)
library(conflicted)
conflict_prefer("filter", "dplyr")
conflict_prefer("select", "dplyr")
conflict_prefer("lag", "dplyr")


# Data
lung <- lung[,c("time","status","sex")]

# Fitting survival curves
fit.gp <- survfit(Surv(time, status) ~ sex, data = lung)

# Creation of an other data frame with the survival data
data_km <-  full_join(fill_survival_data(fit.gp[1]), fill_survival_data(fit.gp[2]), by="time", suffix = c("1", "2")) %>%
  arrange(time) %>%
  mutate(
    surv1:=na.locf(surv1), 
    surv2:=na.locf(surv2))



Create the plot

# We set the xlim, break time
# PLOT

# We set the xlim, break time and palette
break.time.by <- 250
var_time <- "del"
xlim <- c(0, 1000)
palette <- scales::hue_pal()(2)

plot.OS <- ggsurvplot(
  fit.gp,
  xlab = "Time (months)", ylab="Survival probability",
  xlim=xlim, ylim=c(0, 1),
  lwd=0.5,
  break.time.by = break.time.by,
  title="", legend="top", legend.title="Legend title",
  legend.labs=c("Male", "Female"),
  palette=palette,
  conf.int = FALSE,
  pval=T, pval.size=4,
  ggtheme = theme_classic(),
  risk.table = T,
  # risk.table.col = "group",
  risk.table.y.text = TRUE,
  risk.table.y.text.col = TRUE,
  risk.table.fontsize=3,
  risk.table.show.legend = FALSE,
  tables.theme = theme_cleantable()
)

plot.all <- ggplot() +
  geom_step(data = ggplot_build(plot.OS$plot)$data[[1]], aes(x, y, color=factor(group))) + # surv data
  geom_point(data = ggplot_build(plot.OS$plot)$data[[3]], aes(x, y, color=factor(group)), shape=3) + # cens data
  geom_ribbon(data = data_km, mapping = aes(x=time, ymin=surv1, ymax=surv2), fill='black', alpha=.2) +
  theme_classic() + 
  theme(legend.position="top") + labs(color="Legend title") +
  xlab("Time") + ylab("Survival probability") + 
  ylim(0, 1) + 
  coord_cartesian(xlim = xlim) + 
  scale_x_continuous(breaks = seq(0, xlim[2], break.time.by)) +
  scale_color_discrete(labels = c("Male", "Female")) 

ggarrange(plot.all, plot.OS$table, ncol = 1, nrow = 2, heights = c(0.85, 0.15), align = "v")



Add a cut-off :

time_max <- 500

data_km <- rbind(data_km %>% filter(time<=time_max), c(time_max, NA, NA)) %>%
  mutate(
    surv1=na.locf(surv1), 
    surv2=na.locf(surv2))



plot.all <- ggplot() +
  geom_step(data = ggplot_build(plot.OS$plot)$data[[1]], aes(x, y, color=factor(group))) + # surv data
  geom_point(data = ggplot_build(plot.OS$plot)$data[[3]], aes(x, y, color=factor(group)), shape=3) + # cens data
  geom_ribbon(data = data_km %>% filter(time<=time_max), mapping = aes(x=time, ymin=surv1, ymax=surv2), fill='black', alpha=.2) +
  theme_classic() + 
  theme(legend.position="top") + labs(color="Legend title") +
  xlab("Time") + ylab("Survival probability") + 
  ylim(0, 1) + 
  coord_cartesian(xlim = xlim) + 
  scale_x_continuous(breaks = seq(0, xlim[2], break.time.by)) +
  scale_color_discrete(labels = c("Male", "Female")) + 
  geom_vline(xintercept = time_max, linetype = "longdash", color = "black")

ggarrange(plot.all, plot.OS$table, ncol = 1, nrow = 2, heights = c(0.85, 0.15), align = "v")




Contact

This document is a work of the statistics team in the Biostatistics and Medical Information Department at Saint-Louis Hospital in Paris (SBIM).
Developed and updated by Noémie Bigot and Anouk Walter-Petrich
noemie.bigot@aphp.fr; anouk.walter-petrich@u-paris.fr

Based on The R Graph Gallery by Yan Holtz.

SBIM