0

I have a survival dataset with outcomes for multiple groups separated into causes of death, and would like to plot the competing risks of each outcome. This tutorial provides an excellent example of using the cpmrsk and survminer packages to plot competing risks, where each group is placed in a separate panel, and the competing risks shown within each of these groups.

Is there a way to instead plot these data so that each outcome is shown in a separate panel, with the data for all of the groups shown within that panel?

Below is an example from this tutorial...

set.seed(2)
failure_time <- rexp(100)
status <- factor(sample(0:2, 100, replace=TRUE), 0:2,
                 c('no event', 'death', 'progression'))
disease <- factor(sample(1:3,  100,replace=TRUE), 1:3,
                  c('BRCA','LUNG','OV'))
# Cumulative Incidence Function
require(cmprsk)
fit3 <- cuminc(ftime = failure_time, fstatus = status,
              group = disease)
# Visualize
ggcompetingrisks(fit3, palette = "Dark2",
                 legend = "top",
                 ggtheme = theme_bw())

Resulting in:

enter image description here

In this example, the goal would be to instead arrange the three different outcomes (death, no, progression) into three separate panels, with each of the three groups (BRCA, LUNG, OV) overlaid in different colours on the same panel.

I know it is possible to combine all of these data onto one graph by specifying ggcompetingrisks(fit3, multiple_panels=F) but this starts to become difficult to visualise, especially when there become more competing outcomes.

Any advice appreciated, thanks in advance.

Timmo83
  • 119
  • 5

1 Answers1

0

SOLUTION:

Used trace(survminer:::ggcompetingrisks.cuminc, edit = T) to open up the underlying code for this function, changed one line as follows...

function (fit, gnames = NULL, gsep = " ", multiple_panels = TRUE, 
  coef = 1.96, conf.int = FALSE) 
{
  if (!is.null(fit$Tests)) 
    fit <- fit[names(fit) != "Tests"]
  fit2 <- lapply(fit, `[`, 1:3)
  if (is.null(gnames)) 
    gnames <- names(fit2)
  fit2_list <- lapply(seq_along(gnames), function(ind) {
    df <- as.data.frame(fit2[[ind]])
    df$name <- gnames[ind]
    df
  })
  time <- est <- event <- group <- NULL
  df <- do.call(rbind, fit2_list)
  df$event <- sapply(strsplit(df$name, split = gsep), `[`, 
    2)
  df$group <- sapply(strsplit(df$name, split = gsep), `[`, 
    1)
  df$std <- std <- sqrt(df$var)
  pl <- ggplot(df, aes(time, est, color = event))
  if (multiple_panels) {
    pl <- ggplot(df, aes(time, est, color = group)) + facet_wrap(~event)
  }
  else {
    pl <- ggplot(df, aes(time, est, color = event, linetype = group))
  }
  if (conf.int) {
    pl <- pl + geom_ribbon(aes(ymin = est - coef * std, 
      ymax = est + coef * std, fill = event), alpha = 0.2, 
      linetype = 0)
  }
  pl + geom_line()
}

The change was at the line

if (multiple_panels) {
    pl <- ggplot(df, aes(time, est, color = group)) + facet_wrap(~event)

Swapping from color = event and facet_wrap(~group) to color = group and facet_wrap(~event)

This completely solves it.

Timmo83
  • 119
  • 5