手把手教你绘制最基础的列线图

生信修炼手册

发布于 2022-06-09 17:57:15

1.9K0

发布于 2022-06-09 17:57:15

文章被收录于专栏：生信修炼手册生信修炼手册

在之前的文章中，我们介绍了列线图的含义和构建方法，本文重点介绍下绘制列线图的代码，经典的列线图如下所示

当我们构建好一个预后模型之后，可以通过列线图来可视化其公式，最常用的绘图方法是通过rms这个R包，以pbc这个生存分析的数据为例，展示下其基本用法

> library(rms)
> pbc <- pbc[pbc$status %in% c(0, 1), ]
> head(pbc)
   id time status trt      age sex ascites hepato spiders edema bili chol
2   2 4500      0   1 56.44627   f       0      1       1   0.0  1.1  302
5   5 1504      1   2 38.10541   f       0      1       1   0.0  3.4  279
7   7 1832      0   2 55.53457   f       0      1       0   0.0  1.0  322
13 13 3577      0   2 45.68925   f       0      0       0   0.0  0.7  281
16 16 3672      0   2 40.44353   f       0      0       0   0.0  0.7  204
19 19 4232      0   1 49.56057   f       0      1       0   0.5  0.7  235
   albumin copper alk.phos    ast trig platelet protime stage
2     4.14     54   7394.8 113.52   88      221    10.6     3
5     3.53    143    671.0 113.15   72      136    10.9     3
7     4.09     52    824.0  60.45  213      204     9.7     3
13    3.85     40   1181.0  88.35  130      244    10.6     3
16    3.66     28    685.0  72.85   58      198    10.8     3
19    3.56     39   1881.0  93.00  123      209    11.0     3
> dd <- datadist(pbc)
> options(datadist = "dd")
# 生存模型
> f <- psm(Surv(time,status) ~ age + sex, data =  pbc, dist='lognormal')
> nom <- nomogram(f)
> plot(nom)

效果图如下

和文献中的列线图相比，rms的默认输出结果中多出了Linear Predictor这个轴，如果想要去掉这个轴，可以通过如下方法

> f <- psm(Surv(time,status) ~ age + sex, data =  pbc, dist='lognormal')
> nom <- nomogram(f, lp = F)
> plot(nom)

效果图如下

可以看到，LInear Predictor这个轴就不显示了。对于生存模型，我们希望通过该模型预测患者的生存时间和生存概率，基础的列线图显然并没有这样的信息，为此，我们需要自己写函数来添加我们想要的轴，用法如下

> f <- psm(Surv(time,status) ~ age + sex, data =  pbc, dist='lognormal')
> # 计算中位生存时间
> med  <- Quantile(f)
> # 构建生存概率
> surv <- Survival(f)
> nom <- nomogram(f,
+     fun = list(function(x) med(lp = x, q = 0.5),
+                function(x) surv(365,     x),
+                function(x) surv(365 * 3, x),
+                function(x) surv(365 * 5, x)),
+     funlabel = c("Median Survival Time",
+                   "1-year Survival Probability",
+                   "3-year Survival Probability",
+                   "5-year Survival Probability"),
+     lp = F)
> plot(nom)

效果图如下

由于该数据中的生存时间time是以天为单位就算的，因此在计算年的时候进行了转换。虽然加上了我们想要的信息，但是发现坐标轴的标签重叠了，此时有几种方法可以解决这个问题

1. 增加画布的宽度，将宽度加大之后绘图区域变宽，标签间的距离变大，重叠情况会减少

2. 设置标签的文字大小，在plot函数中通过cex.axis参数设置大小

3. 重新设置坐标轴的间隔，通过fun.at参数，用法如下

> nom <- nomogram(f,
+     fun = list(function(x) med(lp   =    x),
+                function(x) surv(365,     x),
+                function(x) surv(365 * 3, x),
+                function(x) surv(365 * 5, x)),
+     funlabel = c("Median Survival Time",
+                   "1-year Survival Probability",
+                   "3-year Survival Probability",
+                   "5-year Survival Probability"),
+     fun.at = list(c(10000, 20000, 30000, 40000, 60000, 90000),
+                   c(0.96, 0.97, 0.98, 0.99, 0.995),
+                   c(0.90, 0.92, 0.94, 0.96, 0.98),
+                   c(0.6, 0.8, 0.9, 0.95)),              
+     lp = F)
> plot(nom)

效果图如下