决策曲线添加彩色条带

前段时间给大家介绍了如何给列线图增加彩色的危险分层条带，详情请见：列线图增加彩色风险分层

并且还介绍了如何根据列线图计算每个患者的得分，并根据得分进行最佳危险分层，请见：根据列线图计算分数并进行危险分层

今天介绍如何为决策曲线添加彩色条带，实现类似于下图的效果：

这张列线图来自于这篇文章：Nomograms in oncology: more than meets the eye，DOI：10.1016/S1470-2045(14)71116-7

这张图在底部增加了两种颜色的条带，分别是Nomogram relevant和Nomogram not relevant。

通常在解读列线图时，我们需要汇报到底在哪个阈值区间内，我们的模型是更有临床意义的，在这个区间内也就是上图中的Nomogram relevant，不在这个区间内就是Nomogram not relevant。

理解这点之后，画图就很简单了。

首先我们看看常规的决策曲线画法。先看看默认的出图：

rm(list = ls())
library(survival)
library(dcurves)

## Warning: package 'dcurves' was built under R version 4.2.3

data("df_surv")

# 加载函数
source("../000files/stdca.R") 

# 构建一个多元cox回归
df_surv$cancer <- as.numeric(df_surv$cancer) # stdca函数需要结果变量是0,1
df_surv <- as.data.frame(df_surv) # stdca函数只接受data.frame

cox_model <- coxph(Surv(ttcancer, cancer) ~ famhistory + marker, data = df_surv)

# 计算1.5年的概率
df_surv$prob1 <- c(1-(summary(survfit(cox_model, newdata=df_surv), times=1.5)$surv))

# 这个函数我修改过，如果你遇到报错，可以通过添加参数 xstop=0.5 解决
cox_dca <- stdca(data=df_surv, 
      outcome="cancer", 
      ttoutcome="ttcancer", 
      timepoint=1.5, 
      predictors="prob1",
      smooth=TRUE,
      xby = 0.001,
      ymin = -0.1
    )

这个默认的出图不是很好看，我们可以自己提取数据，然后使用ggplot2画：

library(tidyr)

cox_dca_df <- cox_dca$net.benefit %>% 
  pivot_longer(cols = c(all,none,prob1_sm),names_to = "models",
               values_to = "net_benefit"
               )

使用ggplot2画图：

library(ggplot2)

library(ggsci)

p1 <- ggplot(cox_dca_df)+
  geom_line(aes(x=threshold,y=net_benefit,color=models),linewidth=1.2)+
  scale_color_jama(name="Models Types",
                   labels=c("All","None","Model1"))+
  scale_x_continuous(labels = scales::label_percent(accuracy = 1),
                     name="Threshold Probility")+
  scale_y_continuous(limits = c(-0.1,0.2),name="Net Benefit")+
  theme_bw(base_size = 14)+
  theme(legend.background = element_blank(),
        legend.position = c(0.85,0.75)
        )
p1

## Warning: Removed 731 rows containing missing values (`geom_line()`).

添加彩色条带的思路也很简单，就是在合适的位置添加矩形色块即可。

首先我们查看下这个合适的阈值区间是多少。左侧的阈值应该就是在相同的横坐标下，Model1的net-benefit开始大于All的位置，右侧阈值应该是Model1的net-benefit开始小于0的位置。

我们直接查看下数据即可，最简单的方法，肉眼看一下。前面在使用ggplot2画图时已经把数据都提取好了，就是cox_dca_df这个数据。

左侧的阈值大概在0.1左右，右侧的阈值大概在0.7左右。因为没有恰好相等的情况，所以只能取个大概的阈值。

左侧阈值：

右侧阈值，0.707的净获益还是正数，0.708的净获益就是负数了，所以这个阈值应该是在0.707~0.708之间，我们就取个大约的数字，0.7。

有了这两个阈值就是有了矩形的坐标，所以下面再准备3个矩形的坐标即可，如果是ggplot2画的图，就用geom_rect()添加矩形。

# 准备3个矩形的坐标
rect_df1 <- data.frame(xmin = 0,
                      xmax = 0.1,
                      ymin = -0.05,
                      ymax = -0.1
                      )
rect_df2 <- data.frame(xmin = 0.1,
                      xmax = 0.7,
                      ymin = -0.05,
                      ymax = -0.1
                      )
rect_df3 <- data.frame(xmin = 0.7,
                      xmax = 1,
                      ymin = -0.05,
                      ymax = -0.1
                      )

解释说明的文字直接使用annotate()函数添加即可：

p2 <- p1+
  geom_rect(data = rect_df1, 
            mapping = aes(xmin = xmin, xmax=xmax,ymin=ymin,ymax=ymax),
            fill = "#0151a2")+
  geom_rect(data = rect_df2, 
            mapping = aes(xmin = xmin, xmax=xmax,ymin=ymin,ymax=ymax),
            fill = "#c01e35")+
  geom_rect(data = rect_df3, 
            mapping = aes(xmin = xmin, xmax=xmax,ymin=ymin,ymax=ymax),
            fill = "#0151a2")+
  annotate(geom = "text", label = "Nomogram relevant", 
           x = 0.4, y = -0.075,
           size = 4.5, color = "white")+
  annotate(geom = "text", label = "Nomogram irrelevant", 
           x = 0.85, y = -0.075,
           size = 4.5, color = "white")
p2

## Warning: Removed 731 rows containing missing values (`geom_line()`).

是不是很easy呢？

还可以再添加2条竖线，使图形更容易理解：

# 准备2条竖线坐标
line_df <- data.frame(x = c(0.1,0.7),
                      ymin = c(-0.05,-0.05),
                      ymax = c(0.13,0)
                      )

添加竖线：

p2+geom_linerange(data = line_df, mapping = aes(x=x,ymin=ymin,ymax=ymax),
                  linetype = 2, linewidth = 1.2
                  )

## Warning: Removed 731 rows containing missing values (`geom_line()`).

如果是默认的出图，那就更简单了，因为都是R语言默认的画图引擎，支持所有base r画图语法，和之前列线图添加彩色条带的方法一模一样：

cox_dca <- stdca(data=df_surv, 
      outcome="cancer", 
      ttoutcome="ttcancer", 
      timepoint=1.5, 
      predictors="prob1",
      smooth=TRUE,
      xby = 0.001,
      ymin = -0.1
    )
# 添加条带
rect(xleft = 0,xright = 0.1,ybottom = -0.05,ytop = -0.1,col = "#0151a2",border = NA)
rect(xleft = 0.1,xright = 0.7,ybottom = -0.05,ytop = -0.1,col = "#c01e35",border = NA)
rect(xleft = 0.7,xright = 1,ybottom = -0.05,ytop = -0.1,col = "#0151a2",border = NA)

# 添加文字
text(x = 0.4, y = -0.075, labels="Nomogram relevant",col="white")
text(x = 0.85, y = -0.075, labels="Nomogram relevant",col="white")

搞定！