R: Survminer двойной граф

Question

Я участвую в проекте, где мы строим кривые выживаемости для события с довольно низкой частотой, а кривые Каплана-Мейера (построенные с использованием survminer) довольно плоские.Я не хочу просто увеличивать ось Y, поскольку думаю, что читатель может неверно истолковать уровень заболеваемости.Один из способов показать «истинную» скорость и увеличить возможные незначительные различия состоит в том, чтобы сделать это так, как это делает NEJM:

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.

Однако я не нашел способасделать это прямо в survminer.Ради воспроизводимости я хотел бы избегать использования какого-либо программного обеспечения Adobe.

Кто-нибудь знает способ получить небольшую увеличенную версию, включенную в верхней части исходного графика?Я хотел бы достичь этого с помощью survminer, но советы по любым другим хорошим пакетам KM на основе ggplot приветствуются.

Небольшой пример:

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

Есть несколько способов сделать это, но одно предложение - тоже составьте два имеющихся у вас графика и расположите их на grid.arrange.Сначала сделайте два участка.Затем вытащите таблицу рисков и построите график отдельно для первого графика (вы не можете поместить объект ggsurvplot в grid.arrange).Вложите второй участок в сюжет один с аннотацией_custom.Наконец, используйте layout_matrix, чтобы указать размеры вашего графика и соединить его с 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
)