2019-03-08 Nomogram
原文地址：https://blog.csdn.net/anshiquanshu/article/details/53444800
首先什么是Nomogram？简单的说这是一种将Logistic回归或Cox回归图形化呈现的方法，可以让读者从图中很简便地根据预测变量的值得到因变量的大致概率数值。其对于Logistic回归或Cox回归的意义，大概相当于散点图对于简单线性回归的意义。具体的介绍以及作图原理，这里就不详述了，有兴趣的请参照附件中SAS公司的一份文档。
下面简单说下Nomogram怎么看。如下图。欲知年龄50岁的女性（sex=1）的患病风险，只需要将age=45岁向points轴投射，则points=50；同理sex=1时，points≈37。两者相加则Total
points=87；将此数值在Total points轴上向Risk概率轴投射，则可知风险大概在0.4和0.5之间。（参见图中红线）对于单个变量，只需要令Total points = points进行投射即可。
接下来讲如何用R语言做出上面的这张图。简单起见，此帖仅讨论Logistic回归，Cox回归的方法类似，但相对更复杂。本帖所用数据引用自上海交大出版《医学统计学及SAS应用（修订版）》的例11.4，详细的内容请参见我的另一个帖子的附件（http://www.dxy.cn/bbs/topic/26880076）。
-------------------------------------代码开始---------------------------------------------
require(rms)
# 建立数据集
y = c(0, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0,
1, 0, 0, 0, 1, 1, 0, 1,
1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1,
0, 1, 0, 0, 0, 1,
1, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1,
0, 0, 1, 1, 1, 0,
0, 0, 1, 0, 1, 0, 1, 0, 1)
age = c(28, 42, 46, 45, 34, 44, 48, 45, 38, 45, 49,
45, 41, 46, 49, 46, 44, 48,
52, 48, 45, 50, 53, 57, 46, 52, 54, 57, 47, 52, 55,
59, 50, 54, 57, 60,
51, 55, 46, 63, 51, 59, 48, 35, 53, 59, 57, 37, 55,
32, 60, 43, 59, 37,
30, 47, 60, 38, 34, 48, 32, 38, 36, 49, 33, 42, 38,
58, 35, 43, 39, 59,
39, 43, 42, 60, 40, 44)
sex = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
1, 0, 1, 0, 1, 0, 1, 0, 1,
0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
1, 0, 1, 0, 1, 0, 1,
0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0,
1, 1, 1, 0, 1, 1, 1,
0, 1, 1, 1, 0, 1)
ECG = c(0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1,
1, 0, 0, 1, 1, 0, 0, 1, 1,
0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 1, 0,
0, 2, 2, 0, 0, 2, 2,
0, 1, 2, 2, 0, 1, 0, 2, 0, 1, 0, 2, 1, 1, 0, 2, 1,
1, 0, 2, 1, 1, 0, 2,
1, 1, 0, 2, 1, 1)
# 设定nomogram的参数
ddist <- datadist(age, sex, ECG)
options(datadist='ddist')
# logistic回归
f <- lrm(y ~ age + sex + ECG)
# nomogram
nom <- nomogram(f, fun=plogis,
fun.at=c(.001, .01, .05, seq(.1,.9, by=.1), .95, .99,
.999),
lp=F, funlabel="Risk")
plot(nom)
-------------------------------------代码结束---------------------------------------------
END。欢迎交流。
Cox回归模型会复杂一些，因为可能涉及到不同时间点（3年、5年）生存概率的计算。下面讨论最简单的概率轴为中位生存时间的情况。若需要在映射轴呈现生存概率，或需要比较不同模型之间的优劣（比如c-index），另外再留言讨论。
require(rms)
require(Hmisc)
# 建立数据集（使用rms包example的代码，未改动）
n <- 1000
set.seed(731)
age <- 50 + 12*rnorm(n)
label(age) <- "Age"
sex <- factor(sample(c('Male','Female'), n,
rep=TRUE, prob=c(.6, .4)))
cens <- 15*runif(n)
h <- .02*exp(.04*(age-50)+.8*(sex=='Female'))
dt <- -log(runif(n))/h
label(dt) <- 'Follow-up Time'
e <- ifelse(dt <= cens,1,0)
dt <- pmin(dt, cens)
units(dt) <- "Year"
# 设定nomogram的参数
ddist <- datadist(age, sex)
options(datadist='ddist')
# Cox回归
S <- Surv(dt,e)
f <- cph(S ~ rcs(age,4)
+ sex, x=T, y=T)
med <- Quantile(f)
# nomogram
nom <- nomogram(f, fun=function(x) med(x),
fun.at=c(13,12,11,9,8,7,6,5),
lp=F, funlabel="Median Survival Time")
plot(nom)
