Is there a way to add tick/censor marks to cumulative incidence plot in R?

Question

I am interested in generating a cumulative incidence plot for competing events that includes tick/censor marks in the curves. I know you can create plots with tick/censor marks using 1-CSH kaplan meier method in the absence of competing risk, but this seems to overestimate the risk probability over time. I am wondering if anyone knows of a way to add tick/censor marks to cumulative incidence plot (see cuminc() plot below) in the presence of competing risks or knows of a package that can account for competing events and adds tick/censor marks. I have been googling around for some time and I haven't found a way to do so. As far as I know, there is not a way to do this currently. Any help would be appreciated. :)

Here are some posts I have seen:

• Cumulative incidence plot in R using ggsurvplot
• https://stats.stackexchange.com/questions/80813/making-a-cumulative-incidence-plot-in-r
• Survival plot appearance (looks like it is 1-CSH)
• Plot censored events in R version 3.3.2
• https://stats.stackexchange.com/questions/543614/can-i-draw-1-cif-cumulative-incidence-function-as-a-survival-curve
• https://cran.r-project.org/web/packages/survival/vignettes/survival.pdf (As user EdM explains the issue, which can also be found in section 2.3.2 Monoclonal gammopathy of Therneau's pdf)

I have looked into documentation for plot(cuminc()) and ggcompetingrisks(ci.cuminc), but haven't seen of a parameter to include tick/censor marks onto the curves.

In the example below, I use the survival ovarian dataset and add an additional event by replacing the fustat with 2 if their futime survival time was < 300.

library(survival)
library(survminer)
library(cmprsk)
library(ggsurvfit)

df <- data.frame(ovarian)
df$fustat2 <- df$fustat
df[df$futime < 300,]$fustat2 <- 2

df$rx <- factor(df$rx, c(1, 2), labels=c('Rx1', 'Rx2'))

# This example is 1-CS KM:
surv.obj <- survfit(Surv(futime, fustat2==1)~rx, data=df)
#plot(surv.obj, fun= function(x) {1 - x}, bty='L', mark.time=TRUE)
plot(surv.obj,  fun="event",              bty='L', mark.time=TRUE)

# ggsurvfit also produces 1-CS KM curve:
ggsurvfit(surv.obj, type = "risk") + add_censor_mark()

# Cumulative incidence Curve:
ci.cuminc <- cuminc(ftime = df$futime, fstatus= df$fustat2, group =  df$rx)

plot(ci.cuminc, lty=c(1, 1, 0, 0), wh=c(-1,-1), ylim=c(0, 0.45))

# Survminer package has ggcompetingrisks()
ggpar(ggcompetingrisks(ci.cuminc[1:2], multiple_panels = FALSE, censor=TRUE, censor.shape="+"), ylab = "Probablity")

Answer 1

You can do this with the ggsurvfit package. You'll want to use tidycmprsk::cuminc() to estimate the CIF, the use ggsurvfit::ggcuminc() to plot the risk curves. The package exports a ggsurvfit::add_censor_mark() function to add the censoring indicators.

In the example below, all subjects were censored at the same time (24 months) if they hadn't died from cancer, so all the marks appear at the same spot. It would look more interesting with a more interesting censoring distribution.

library(ggsurvfit)
#> Loading required package: ggplot2
library(tidycmprsk)

cuminc(Surv(ttdeath, death_cr) ~ trt, trial) %>%
  ggcuminc(outcome = "death from cancer") +
  add_censor_mark(size = 5) +
  scale_ggsurvfit(x = list(breaks = seq(0, 24, by = 6)))

^{Created on 2024-01-25 with reprex v2.0.2}