library(survival)
library(rms)
dim(lung)
## [1] 228 10
str(lung)
## 'data.frame': 228 obs. of 10 variables:
## $ inst : num 3 3 3 5 1 12 7 11 1 7 ...
## $ time : num 306 455 1010 210 883 ...
## $ status : num 2 2 1 2 2 1 2 2 2 2 ...
## $ age : num 74 68 56 57 60 74 68 71 53 61 ...
## $ sex : num 1 1 1 1 1 1 2 2 1 1 ...
## $ ph.ecog : num 1 0 0 1 0 1 2 2 1 2 ...
## $ ph.karno : num 90 90 90 90 100 50 70 60 70 70 ...
## $ pat.karno: num 100 90 90 60 90 80 60 80 80 70 ...
## $ meal.cal : num 1175 1225 NA 1150 NA ...
## $ wt.loss : num NA 15 15 11 0 0 10 1 16 34 ...
13 列线图添加彩色风险分层
列线图可以用图形化的方式展示逻辑回归和Cox回归,是临床预测模型的重要方法之一,咱们在之前已经给大家介绍过非常多关于列线图的知识了:
下面给大家介绍如何绘制带有彩色风险条的列线图:
在传统列线图的底部添加一条彩色条带,展示不同的风险分层,一下子就让原本死板的列线图变得生动活泼了有木有?
今天我们就学习一下这个图。
13.1 加载数据和R包
13.2 传统列线图
大多数情况下都是使用1代表死亡,0代表删失,这个数据集用2代表死亡。在这里没有影响,但有的R包会报错,需要注意!
<- datadist(lung)
dd options(datadist = "dd")
构建cox比例风险模型:
<- cph(Surv(time, status) ~ age + sex + ph.ecog + ph.karno + pat.karno,
coxfit data = lung, surv = T)
# 构建生存函数,注意你的最大生存时间
<- Survival(coxfit)
surv <- function(x) surv(365,x) # 1年OS
surv1 <- function(x) surv(365*2,x) # 2年OS
surv2
<- nomogram(coxfit,
nom fun = list(surv1,surv2),
lp = T,
funlabel = c('1-year survival Probability',
'2-year survival Probability'),
maxscale = 100,
fun.at = c(0.95,0.9,0.8,0.7,0.6,0.5,0.4,0.3,0.2,0.1))
然后就是默认的画图,没有任何难度:
plot(nom,
lplabel="Linear Predictor",
xfrac = 0.2, # 左侧标签距离坐标轴的距离
#varname.label = TRUE,
tcl = -0.2, # 刻度长短和方向
lmgp = 0.1, # 坐标轴标签距离坐标轴远近
points.label ='Points',
total.points.label = 'Total Points',
cap.labels = FALSE,
cex.var = 1, # 左侧标签字体大小
cex.axis = 1, # 坐标轴字体大小
col.grid = gray(c(0.8, 0.95))) # 竖线颜色
13.3 新型列线图
如何给列线图添加风险分层条带呢?其实思路是很简单的,只要在合适的位置插入颜色条即可。
为了达到这个目的,需要你对base r
的绘图语法足够熟悉。
直接用rect
即可在原图形继续添加矩形区域,然后给它一个颜色即可,除此之外,我们还可以用text
函数在底部添加文字提示,让这个图形看上去更加美观实用。
#pdf("nomogram.pdf")
plot(nom,
lplabel="Risk Stratification",
xfrac = 0.2, # 左侧标签距离坐标轴的距离
#varname.label = TRUE,
tcl = -0.2, # 刻度长短和方向
lmgp = 0.1, # 坐标轴标签距离坐标轴远近
points.label ='Points',
total.points.label = 'Total Points',
cap.labels = FALSE,
cex.var = 1, # 左侧标签字体大小
cex.axis = 1, # 坐标轴字体大小
col.grid = gray(c(0.8, 0.95))) # 竖线颜色
rect(0.29,0.20,0.5,0.26,col = "#01847F") # 添加彩色条带
rect(0.5,0.20,0.7,0.26,col = "#FBD26A")
rect(0.7,0.20,0.935,0.26,col = "#F40002")
text(0.4,0.18,"Low")
text(0.6,0.18,"Medium")
text(0.83,0.18,"High")
#dev.off()
这样一个新型的带颜色条的列线图就绘制好了。是不是很简单呢?
我说说我的具体思路,首先用rect
函数添加3个彩色条带,其用法是rect(min(x),min(y),max(x),max(y))
,前四个参数确定位置。然后使用text
函数在合适的位置添加文字即可。
这个彩色条带刚好覆盖在原来的Linear Predictor
的位置,当然这个位置需要你不断的尝试才能确定,而且我这里的风险分层为了演示是随便选的,你需要根据自己的实际情况确定到底什么分数段属于什么分层,然后不断调整位置直到你满意为止。
但是这个图现在还是有点问题的,主要是左侧遗留了一个-1
,没办法去掉。
当然了,你也可以直接把传统列线图保存为PDF,然后用AI等软件编辑,更加自由!
13.4 继续改进
我又去pubmed以及google使用关键词nomogram
继续搜索,果然又搜到一篇带有彩色条带的列线图,而且我感觉这个图更加好看!
文献DOI:10.1093/eurheartj/ehab294
上面这个图不仅有彩色条带展示分层,而且还增加了彩色箭头标识,并在最底部也增加了彩色线条标识。
下面我们继续学习这个列线图怎么画,思路和上面基本是一样的。
首先是再添加一个颜色条:
#pdf("nomogram.pdf")
plot(nom,
lplabel="Risk Stratification",#名字就不改了
xfrac = 0.2, # 左侧标签距离坐标轴的距离
#varname.label = TRUE,
tcl = -0.2, # 刻度长短和方向
lmgp = 0.1, # 坐标轴标签距离坐标轴远近
points.label ='Points',
total.points.label = 'Total Points',
cap.labels = FALSE,
cex.var = 1, # 左侧标签字体大小
cex.axis = 1, # 坐标轴字体大小
col.grid = gray(c(0.8, 0.95))) # 竖线颜色
rect(0.29,0.245,0.5,0.26,col = "#01847F") # 添加彩色条带
rect(0.5,0.245,0.7,0.26,col = "#FBD26A")
rect(0.7,0.245,0.935,0.26,col = "#F40002")
text(0.4,0.28,"Low")
text(0.6,0.28,"Medium")
text(0.83,0.28,"High")
#在底部再增加3个彩色条带,高度错开,显得有层次感
rect(0.37,0.14,0.5,0.144,col = "#01847F")
rect(0.5,0.144,0.7,0.148,col = "#FBD26A")
rect(0.7,0.148,0.835,0.152,col = "#F40002")
#如果你还要继续添加文字说明也可以,我这里就不加了
#dev.off()
彩色箭头如何添加?一模一样的思路,选择一个你想展示的病人,然后计算它每一项的分数,然后使用arrows
函数在合适的位置绘制箭头即可。
下面随便展示下,我这里并没有认真计算这个人的各项分数。如果你需要展示,可以用nomogramformula
包计算,或者看下一篇文章演示。
#pdf("nomogram.pdf")
plot(nom,
lplabel="Risk Stratification",#名字就不改了
xfrac = 0.2, # 左侧标签距离坐标轴的距离
#varname.label = TRUE,
tcl = -0.2, # 刻度长短和方向
lmgp = 0.1, # 坐标轴标签距离坐标轴远近
points.label ='Points',
total.points.label = 'Total Points',
cap.labels = FALSE,
cex.var = 1, # 左侧标签字体大小
cex.axis = 1, # 坐标轴字体大小
col.grid = gray(c(0.8, 0.95))) # 竖线颜色
rect(0.29,0.245,0.5,0.26,col = "#01847F") # 添加彩色条带
rect(0.5,0.245,0.7,0.26,col = "#FBD26A")
rect(0.7,0.245,0.935,0.26,col = "#F40002")
text(0.4,0.28,"Low")
text(0.6,0.28,"Medium")
text(0.83,0.28,"High")
#在底部再增加3个彩色条带,高度错开,显得有层次感
rect(0.37,0.14,0.5,0.144,col = "#01847F")
rect(0.5,0.144,0.7,0.148,col = "#FBD26A")
rect(0.7,0.148,0.835,0.152,col = "#F40002")
#如果你还要继续添加文字说明也可以,我这里就不加了
# 添加箭头
arrows(0.205,0.86,0.205,0.96,col = "steelblue",lwd = 4,length = 0.1)
arrows(0.4,0.76,0.4,0.96,col = "steelblue",lwd = 4,length = 0.1)
arrows(0.68,0.655,0.68,0.96,col = "steelblue",lwd = 4,length = 0.1)
arrows(0.28,0.55,0.28,0.96,col = "steelblue",lwd = 4,length = 0.1)
arrows(0.47,0.45,0.47,0.96,col = "steelblue",lwd = 4,length = 0.1)
# 总分箭头,加起来可能不对,单纯演示下
arrows(0.84,0.40,0.84,0.35,col = "#F40002",lwd = 4,length = 0.1)
#dev.off()
这样一个非常漂亮的列线图就画好了,层次分明,细节满满,让人耳目一新,大家赶紧用起来吧!