Match ggsurvplot legend text color to line color, include risk table

Question

Related to this previous post about changing the color of the figure legend text to match graphing colors in ggplot, I would like to extend this to ggsurvplot objects.

fit <- survfit(Surv(time, status) ~ sex, data = lung)
fitgraph <- ggsurvplot(fit, 
                       risk.table = TRUE, risk.table.y.text.col = TRUE)
fitgraph

What I would really like to do is change the color of the text on the legend to match the color of the lines on the graph.

Using this previous solution from Z Cao I can convert the ggsurvplot$plot to a grob, change the legend text color, and then convert back into a ggplot object, which works fine...

g1 <- fitgraph

pGrob <- ggplotGrob(g1$plot)
g.b   <- pGrob[["grobs"]][[which(pGrob$layout$name=="guide-box")]]
l     <- g.b[[1]][[1]][["grobs"]]
# get grobs for legend symbols (extract color)
lg    <- l[sapply(l, function(i) grepl("GRID.segments", i))] 
clr   <- mapply(FUN=function(x){x$gp$col},x=lg)

gb  <- which(grepl("guide-box", pGrob$layout$name))
gb2 <- which(grepl("guides", pGrob$grobs[[gb]]$layout$name))
label_text <- which(grepl("label",pGrob$grobs[[gb]]$grobs[[gb2]]$layout$name))

pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text] <- 
  mapply(FUN = function(x, y) {x[["children"]][[1]][["children"]][[1]]$gp <- gpar(col =y); return(x)},
         x =   pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text],
         y =  clr, SIMPLIFY = FALSE)
grid.draw(pGrob)

Then convert this back into a ggplot object, with color of figure legend text changed to match the color of lines as desired...

plot1 <- as.ggplot(pGrob)
plot1

Where I am stuck is now integrating this with the original ggsurvplot risk table underneath, as in the first graph.

My pretty basic reaction was to simply replace the ggsurvplot$plot with the new ggplot object created after extracting the original plot to a grob and then back to a ggplot...

g1$plot <- plot1

However this does not work...

Error in [.data.frame(g$data[1], "colour") : undefined columns selected

Most likely due to a loss of the underlying data in the process above, storing only a 2x2 table...

plot1$data
  x y
1 0 0
2 1 1

Compared to the original fitgraph$plot$data which yields the entire data set (hundreds of rows, ongoing survival proportions) which presumably feeds the risk table. The other dumb strategy of plot1 + fitgraph$table doesn't work either.

There must be a better strategy - any ideas? Thanks in advance!

EDIT Thanks to Stefan for the ggtext solution below, however each of my ggsurvplots has a different color scheme, and applying this method seems to over-ride these, e.g.

fit <- survfit(Surv(time, status) ~ sex, data = lung)
fitgraph <- ggsurvplot(fit, 
                       risk.table = TRUE, 
                       palette=c("#B79F00", "#619CFF"),
                       risk.table.col = "strata")

For a graph that looks like...

That looks good but when I then apply the method to change the legend color...

cols <- c("#B79F00", "#619CFF")

labels <- function(x, cols) {
  glue::glue("<span style = 'color: {cols}'>{x}</span>")
}

fitgraph$plot <- fitgraph$plot +
  scale_color_discrete(labels = ~labels(.x, cols)) +
  theme(legend.text = element_markdown())

fitgraph

This results in a loss of the original graph colors...

Scale for 'colour' is already present. Adding another scale for 'colour', which will replace the existing scale.

Any ideas? Thanks again...

Answer 1

While I appreciate your effort the ggtext package offers an easy option to achieve your desired result. Besides making it easier to set the legend text colors the final result could simply assigned back to the plot element of the ggurvplot object:

library(survival)
library(survminer)
library(ggtext)

fit <- survfit(Surv(time, status) ~ sex, data = lung)
fitgraph <- ggsurvplot(fit, risk.table = TRUE, risk.table.y.text.col = TRUE)

cols <- scales::hue_pal()(2)

labels <- function(x, cols) {
  glue::glue("<span style = 'color: {cols}'>{x}</span>")
}

fitgraph$plot <- fitgraph$plot +
  scale_color_discrete(labels = ~labels(.x, cols)) +
  theme(legend.text = element_markdown())

fitgraph

UPDATE In case you pass a custom color palette we have to switch to scale_color_manual and pass the colors to the values argument. One drawback is that in that case we get a warning as we replace the already existing scale_color_manual:

library(survival)
library(survminer)
library(ggtext)

cols <- c("#B79F00", "#619CFF")

fit <- survfit(Surv(time, status) ~ sex, data = lung)
fitgraph <- ggsurvplot(fit, risk.table = TRUE, risk.table.y.text.col = TRUE, palette=cols)

labels <- function(x, cols) {
  glue::glue("<span style = 'color: {cols}'>{x}</span>")
}

fitgraph$plot <- fitgraph$plot +
  scale_color_manual(values = cols, labels = ~labels(.x, cols)) +
  theme(legend.text = element_markdown())
#> Scale for 'colour' is already present. Adding another scale for 'colour',
#> which will replace the existing scale.

fitgraph