スパークライン風のカプランマイヤープロット

層分けが多くなると凡例と見比べるのが大変なのでなんとかしたいと思った。

普通にプロットする。

はい。

スパークライン風にプロットするとこんな感じかなあ。

累積イベント発生率が25%に達する点、50%に達する点、75%に達する点に赤っぽい丸、最後のイベント発生に黒い丸をうっている。

また背景のグレーの帯は25%〜75%の範囲を示している。

以下 R の コードです。

library(survival)library(tidyverse)library(survminer)
lung2 <- lung %>% 
  filter(ph.ecog!=3)
sf <-survfit(Surv(time,status)~sex+ph.ecog,data=lung2)

ggsurvplot(sf,fun ="event")

sf_df <-data_frame(time=sf$time,event=1-sf$surv,strata=rep(sub("treat=","",names(sf$strata)),sf$strata))

strata=cumsum(sf$strata)
max_df<-data.frame(strata=names(strata),
                   time=sf$time[strata],
                   event=1-sf$surv[strata])

sf_q <-quantile(sf,probs = c(0.25,0.5,0.75))

q_df<-sf_q$quantile %>% 
  as_data_frame()%>% 
  mutate(strata=rownames(sf_q$quantile))%>% 
  gather(q,time,-strata)%>% 
  mutate(event=as.numeric(q)/100)

spark <-   theme_classic(16)+
  theme(axis.title=element_blank(),
        axis.line.y = element_blank(),
        panel.border = element_rect(color ="black",fill=NA),
        strip.text.x = element_blank(),
        strip.text.y = element_text(angle =0),
        strip.background = element_blank())

ggplot(sf_df,aes(x=time,y=event))+
  annotate("rect",xmin=0,xmax=max(sf$time),ymin=0.25,ymax=0.75,
           alpha=0.35,fill="gray")+
  geom_step()+
  geom_point(data=max_df)+
  scale_y_continuous(breaks=c(0.25,0.75))+
  geom_point(data=q_df,aes(x=time),colour="salmon",size=2)+
  facet_grid(strata~.)+
  spark