We will here use the ggcompetingrisks1 and the
ggcombine functions in the Data & Functions
page.
Download
ggcompetingrisks1.R
# Libraries
library(cmprsk)
library(survminer)
library(ggplot2)
# Creation of dataset
set.seed(2)
df1 <- data.frame(eventA=sample(c(0, 1, 2),100,replace=TRUE,prob = c(0.3, 0.6, 0.1)), del_eventA=rexp(100)*5,
eventB=sample(c(0, 1, 2),100,replace=TRUE,prob = c(0.3, 0.4, 0.2)), del_eventB=rexp(100)*5)
df2 <- data.frame(eventA=sample(c(0, 1, 2),100,replace=TRUE,prob = c(0.3, 0.2, 0.5)), del_eventA=rexp(100)*5,
eventB=sample(c(0, 1, 2),100,replace=TRUE,prob = c(0.3, 0.1, 0.6)), del_eventB=rexp(100)*5)
# cuminc object
fit1A <- cuminc(df1$del_eventA, df1$eventA)
fit1B <- cuminc(df1$del_eventB, df1$eventB)
fit2A <- cuminc(df2$del_eventA, df2$eventA)
fit2B <- cuminc(df2$del_eventB, df2$eventB)Create all plots:
# We set the xlim, break time
break.time.by <- 6
xlim <- c(0, 24)
# pop 1 - icc1
var_time <- "del_eventA"
paletteA <- "#F8766D"
plot.icc1A <- ggcompetingrisks1(
fit1A,
xlab = "Time (months)", ylab="Cumulative incidence",
xlim=xlim, ylim=c(0, 1),
lwd=0.5,
title="", legend="top", legend.title="",
palette=paletteA,
conf.int = F,
event_suppr = c(2),
ggtheme = theme_classic(),
) + scale_x_continuous(breaks = seq(0, floor(max(df1[, var_time], na.rm=T)), break.time.by))
# pop 1 - icc2
var_time <- "del_eventB"
paletteB <- "#00BA38"
plot.icc1B <- ggcompetingrisks1(
fit1B,
xlab = "Time (months)", ylab="Cumulative incidence",
xlim=xlim, ylim=c(0, 1),
lwd=0.5,
title="", legend="top", legend.title="",
palette=paletteB,
conf.int = F,
event_suppr = c(2),
ggtheme = theme_classic(),
) + scale_x_continuous(breaks = seq(0, floor(max(df1[, var_time], na.rm=T)), break.time.by))
# pop 2 - icc1
var_time <- "del_eventA"
paletteA <- "#F8766D"
plot.icc2A <- ggcompetingrisks1(
fit2A,
xlab = "Time (months)", ylab="Cumulative incidence",
xlim=xlim, ylim=c(0, 1),
lwd=0.5,
title="", legend="top", legend.title="",
palette=paletteA,
conf.int = F,
event_suppr = c(2),
ggtheme = theme_classic(),
) + scale_x_continuous(breaks = seq(0, floor(max(df2[, var_time], na.rm=T)), break.time.by))
# pop 2 - icc2
var_time <- "del_eventB"
paletteB <- "#00BA38"
plot.icc2B <- ggcompetingrisks1(
fit2B,
xlab = "Time (months)", ylab="Cumulative incidence",
xlim=xlim, ylim=c(0, 1),
lwd=0.5,
title="", legend="top", legend.title="",
palette=paletteB,
conf.int = F,
event_suppr = c(2),
ggtheme = theme_classic(),
) + scale_x_continuous(breaks = seq(0, floor(max(df2[, var_time], na.rm=T)), break.time.by))Combine all ggcompetingrisks in the same plot:
list_obj <- list(plot.icc1A, plot.icc1B, plot.icc2A, plot.icc2B)
name_obj <- c("A", "B", "A", "B")
linetype_obj <- c("pop1", "pop1", "pop2", "pop2")
plot.all <- ggcombine(list_obj, name_obj, linetype_obj) +
theme_classic() +
theme(legend.position="top") + labs(color="") + labs(linetype="") +
xlab("Time") + ylab("Survival probability") +
ylim(0, 1) +
coord_cartesian(xlim = xlim) +
scale_x_continuous(breaks = seq(0, xlim[2], break.time.by))
plot.all