How can I add a risk table with the breakdown of each event type in the cumulative incidence function plot using 'ggcuminc'?

Question

I have two types of events in this dataset that I am trying to plot on a cumulative incidence plot.

data(Melanoma, package = "MASS")
Melanoma <- Melanoma %>%mutate(
status = as.factor(recode(status, `2` = 0, `1` = 1, `3` = 2)))
###status 0=alive, 1=died from melanoma, 2=dead from other causes

cuminc(Surv(time, status) ~ 1, data = Melanoma) %>% 
ggcuminc(outcome = c("1", "2")) +
labs(
x = "Days") + 
  add_confidence_interval() +
  add_risktable()

The risk table shows two rows: at risk and events.

What I need is to have a risk table showing the breakdown of each events. For example, it should have three rows, one indicating people at risk, another with events 1, and next with events 2.

I haven't found any potential way to solve this.

Answer 1

Checking the Melanome data.frame and the parameters of ggcuminc function, I understand that you want to visualizate the cumulative incidence of events 1=died from melanoma and 2=dead from other causes

data(Melanoma, package = "MASS")
Melanoma <- Melanoma %>% mutate(status = as.factor(recode(status, `2` = 0, `1` = 1, `3` = 2))) 
Melanoma %>% count(status)
  status   n
1      1  57
2      2 134
3      3  14

Therefore, it does not make sense to keep the patients assigned status=0. It is not possible to know the cause of death for these patients.

df.death <- Melanoma %>% filter(status != 0)

All patients show an event (died from melanoma or dead from other causes) so status is fixed to 1. There is not censor elements althought a level must be defined in status.

df.status <- df.death %>% mutate(death=status) %>% mutate(death=factor(death,levels=c(1,2))) %>%
  mutate(status = 1) %>% mutate(status=factor(status,levels=c(0,1)))

Cumulative incidence is plotted with the risk tables (at risk and events) for the two events (1 and 2)

cuminc(Surv(time, status) ~ death, df.event) %>% 
  ggcuminc(outcome = c("1")) +
  labs(
    x = "Days") + 
  add_confidence_interval() +
  add_risktable()

Answer 2

There is no native way to do this in ggsurvfit. But the package exports utilities that make it possible. Example below.

library(ggsurvfit)
#> Loading required package: ggplot2
packageVersion("ggsurvfit")
#> [1] '1.0.0'
library(tidycmprsk)
library(dplyr)

cuminc <- cuminc(Surv(ttdeath, death_cr) ~ 1, trial)

# build a risk table
gg_risktable <- 
  cuminc |> 
  tidy_cuminc(times = c(0, 5, 10, 15, 20)) |> 
  select(outcome, time, n.risk, cum.event) %>%
  {distinct(., time, n.risk) |> 
      mutate(outcome = "At Risk") |> 
      rename(stat = n.risk) |> 
      bind_rows(select(., outcome, time, stat = cum.event))} |> 
  ggplot(aes(x = time, y = factor(outcome), label = stat)) +
  geom_text(size = 3) +
  labs(y = NULL, x = NULL) +
  theme_light() +
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major = element_blank()
  )
gg_risktable

# build a cuminc plot
gg_cuminc <- 
  cuminc |> 
  ggcuminc(outcome = c("death from cancer", "death other causes")) +
  scale_ggsurvfit()

# align and combine plots
gg_combined <- ggsurvfit_align_plots(list(gg_cuminc, gg_risktable))
patchwork::wrap_plots(
  gg_combined[[1]], 
  gg_combined[[2]], 
  ncol = 1,
  heights = c(1, 0.2)
)

^{Created on 2023-11-01 with reprex v2.0.2}