R: Survminer double graph

Question

I am involved in a project where we are plotting survival curves for an event with a pretty low incidence, and the Kaplan-Meier curves (plotted using survminer) are pretty flat. I do not want to simply zoom in on the Y-axis as I think the incidence rates may then be misinterpreted by the reader. One way to show both the 'true' rate and zoom in on eventual small differences is to do it as NEJM does it:

https://www.nejm.org/na101/home/literatum/publisher/mms/journals/content/nejm/2011/nejm_2011.364.issue-9/nejmoa1007432/production/images/img_large/nejmoa1007432_f1.jpeg.

I have, however, not found a way to do this directly in survminer. For reproducibility's sake, I would like to avoid involving any Adobe software.

Does anyone know a way to get a small, zoomed in version included on top of the original graph? I would like to accomplish this with survminer but tips on any other good ggplot-based KM packages are appreciated.

Small example:

library(survival)
library(survminer)

df <- genfan
df$treat<-sample(c(0,1),nrow(df),replace=TRUE)
fit <- survfit(Surv(hours, status) ~ treat, data = df)

p <- ggsurvplot(fit, data = df, risk.table = TRUE, fun = 'event', ylim = c(0, 1))
p # Normal flat, singular graph

Answer 1

There are a few ways to do this but one suggestion is too make the two plots you have and arrange them with grid.arrange. First make the two plots. Then pull out the risk table and plot separately for the first plot (you cannot put a ggsurvplot object in a grid.arrange). Nest the second plot in plot one with a annotation_custom. Finally, use layout_matrix to specify the dimensions of your plot and put it back together with grid.arrange.

library(survival)
library(survminer)
library(grid)
library(gridExtra)

df <- genfan
df$treat<-sample(c(0,1),nrow(df),replace=TRUE)
fit <- survfit(Surv(hours, status) ~ treat, data = df)

p <- ggsurvplot(fit, data = df, risk.table = TRUE, fun = 'event', ylim = c(0, 1))
#zoomed plot and remove risk table
g <- ggsurvplot(fit, data = df, risk.table = FALSE, fun = 'event', ylim = c(0, .5))

risktab <- p$table

justplot <- p$plot

p2 <- justplot + 
      annotation_custom(grob = ggplotGrob(g$plot+
                            theme(legend.position = "none")),
                             xmin = 60,xmax=Inf,ymin = .5,ymax = Inf)

lay <- rbind(c(1,1),
             c(1,1),
             c(2,2))

gridExtra::grid.arrange(p2, risktab,
                        #use layout matrix to set sizes
                        layout_matrix=lay
)