Combine competing Risks

# Libraries
library(cmprsk)
library(survminer)
library(ggplot2)

# Data used
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)

# 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))

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