rm(list = ls())
library(survival)
library(dcurves)
data("df_surv")
# 加载函数
source("E:/R/r-clinical-model/000files/stdca.R")
# 构建一个多元cox回归
$cancer <- as.numeric(df_surv$cancer) # stdca函数需要结果变量是0,1
df_surv<- as.data.frame(df_surv) # stdca函数只接受data.frame
df_surv
<- coxph(Surv(ttcancer, cancer) ~ famhistory + marker,
cox_model data = df_surv)
# 计算1.5年的概率
$prob1 <- c(1-(summary(survfit(cox_model, newdata=df_surv),
df_survtimes=1.5)$surv))
# 这个函数我修改过,如果你遇到报错,可以通过添加参数 xstop=0.5 解决
<- stdca(data=df_surv,
cox_dca outcome="cancer",
ttoutcome="ttcancer",
timepoint=1.5,
predictors="prob1",
smooth=TRUE,
xby = 0.001,
ymin = -0.1
)
37 决策曲线添加彩色条带
前面给大家介绍了如何给列线图增加彩色的危险分层条带,详情请见:列线图增加彩色风险分层
并且还介绍了如何根据列线图计算每个患者的得分,并根据得分进行最佳危险分层,请见:根据列线图计算分数并进行危险分层
今天介绍如何为决策曲线添加彩色条带,实现类似于下图的效果:
这张列线图来自于这篇文章: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。
理解这点之后,画图就很简单了。
首先我们看看常规的决策曲线画法。先看看默认的出图:
这个默认的出图不是很好看,我们可以自己提取数据,然后使用ggplot2
画:
library(tidyr)
<- cox_dca$net.benefit %>%
cox_dca_df pivot_longer(cols = c(all,none,prob1_sm),names_to = "models",
values_to = "net_benefit"
)
使用ggplot2
画图:
library(ggplot2)
library(ggsci)
<- ggplot(cox_dca_df)+
p1 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.inside = c(0.85,0.75)
) p1
添加彩色条带的思路也很简单,就是在合适的位置添加矩形色块即可。
首先我们查看下这个合适的阈值区间是多少。左侧的阈值应该就是在相同的横坐标下,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个矩形的坐标
<- data.frame(xmin = 0,
rect_df1 xmax = 0.1,
ymin = -0.05,
ymax = -0.1
)<- data.frame(xmin = 0.1,
rect_df2 xmax = 0.7,
ymin = -0.05,
ymax = -0.1
)<- data.frame(xmin = 0.7,
rect_df3 xmax = 1,
ymin = -0.05,
ymax = -0.1
)
解释说明的文字直接使用annotate()
函数添加即可:
<- p1+
p2 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
是不是很easy呢?
还可以再添加2条竖线,使图形更容易理解:
# 准备2条竖线坐标
<- data.frame(x = c(0.1,0.7),
line_df ymin = c(-0.05,-0.05),
ymax = c(0.13,0)
)
添加竖线:
+geom_linerange(data = line_df, mapping = aes(x=x,ymin=ymin,ymax=ymax),
p2linetype = 2, linewidth = 1.2
)
如果是默认的出图,那就更简单了,因为都是R语言默认的画图引擎,支持所有base r
画图语法,和之前列线图添加彩色条带的方法一模一样:
<- stdca(data=df_surv,
cox_dca 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")
搞定!