R语言基于Logistic回归绘制限制性立方样条图（Restricted Cubic Spline）

• 相关介绍：

在病因推断、剂量效应研究中，时常要分析自变量和因变量的数量关系。广义线性模型，如Logistic回归、Possion回归等是应用比较广泛的方法。它的一个重要假设是通过选择合适的链接函数，因变量与自变量的关系呈线性。这个假设在某些情况下并不成立。

此时一个常见的处理是采用百分位数等方法将连续性变量分段(P value for trend)。但是分段往往主观，而且损失信息，并有可能引入偏倚。本文介绍限制性立方样条拟合自变量和因变量之间的非线性关系。

限制性立方样条中节点的个数(k)和位置可以由研究人员根据研究背景和数据选择。当有较强的背景知识支持，知道自变量和应变量的关系在某些特定节点转折时，可以选择这些特定的节点。但是实际上往往没有足够的背景知识足以确定节点的个数和位置。所幸绝大多数情况下，节点的位置对限制性立方样条的拟合影响不大，相对来说节点的个数是更关键的参数。节点的个数决定曲线的形状，或者说平滑程度。当节点的个数为2时，得到的拟合曲线就是一条直线。当节点个数等于样本量时，相当于将各个点用线段相连，得到的是完全拟合但是不平滑的折线。由于节点个数的选择和自由度有关，所以当样本量比较大的时候可以取较多的节点。但是，一般来说节点个数取3～7就足够了。

---

---

• RCS案例图形：

---

• R语言代码实现：

  利用library()函数加载本案例所需R包，R程序代码如下：

library(smoothHR)
library(survival)
library(rms)
library(Hmisc)

导入数据，并查看变量名称，R程序代码如下：

RCS <- read.csv("RCS.csv")
names(RCS

因变量group 、自变量VO2max、协变量Age、BMI。

寻找最优节点数knots，R程序代码如下：

for (i in 3:7) {
  fit <- glm(group~rcs(BMI,nk=i)+Age+VO2max,data=RCS, family = binomial())
  tmp <- extractAIC(fit)
  if(i == 3) {AIC = tmp[2]; nk = 3}
  if(tmp[2] < AIC) {AIC = tmp[2]; nk = i} 
}

以上代码为根据AIC准则筛选最小AIC对应的knots。结果显示最优knots为3。

开始拟合模型，R程序代码如下：

# 连续变量BMI被样条化
fit <- lrm(group~rcs(BMI,nk=nk)+Age+VO2max,data=RCS, x=TRUE,y=TRUE)
anova(fit)

输出结果如下：

 Wald Statistics     Response: group  Factor     Chi-Square d.f.   P      BMI         97.12     4    <.0001  Nonlinear  6.35     3    0.033 Age         27.62     1    <.0001 VO2max       0.21     1    0.6444 TOTAL      111.02     6    <.0001

结果显示非线性的P值=0.033，提示存在非线性。

将非线性P值提取出来，方便后续作图，R程序代码如下：​​​​​​​

##p-non-linear
p <-round(anova(fit)[,3],3)

设置参考值，这是一个具有生物/医学意义的参考值。无论参考值为何，该点处的OR为1，R程序代码如下：

refvalue <- 21.75 

对数据进行打包，并指定参考值，R程序代码如下：​​​​​​​

ddist<-datadist(RCS)
ddist$limits$BMI[2]<-refvalue
options(datadist="ddist")

将模型预测的OR值储存在pred_OR中，R程序代码如下：

pred_OR<-Predict(fit,BMI,ref.zero=TRUE,fun=exp)

开始绘制图形：​​​​​​​

# 设置密度曲线的背景色
violet <- "#89439B"
# 绘制左右双坐标轴baseplot
par(mar = c(5, 4, 4, 4) + 0.3)
par(xpd=NA)
ylim.bot<-min(pred_OR[,"lower"])
ylim.top<-max(pred_OR[,"upper"])
# 先画密度图以免遮挡下面的线图
dens <- density(RCS$BMI) # 计算密度
plot(dens$x,dens$y, col=ggplot2::alpha(violet,0.5), type="l", xlab = "", ylab = "",xaxt="n",yaxt="n")
polygon(dens$x,dens$y,col = ggplot2::alpha(violet,0.5),border = ggplot2::alpha(violet,0.5)) # 颜色透明化防遮盖线条
par(new=TRUE) # 新增画布
plot(pred_OR[,1],pred_OR[,"yhat"], 
     xlab = "BMI",ylab = paste0("OR where the refvalue for BMI is ",refvalue),
     type = "l",ylim = c(ylim.bot,ylim.top),
     col="red",lwd=2) 
lines(pred_OR[,1],pred_OR[,"lower"],lty=2,lwd=1.5)
lines(pred_OR[,1],pred_OR[,"upper"],lty=2,lwd=1.5)
lines(x=range(pred_OR[,1]),y=c(1,1),lty=3,col="grey40",lwd=1.3) #
points(refvalue,1,pch=16,cex=1.2)
#附上refvalue的值，具体位置可以自己修改
text(refvalue + 2, 1.1, paste0("refvalue = ",refvalue)) 
# 绘制图例，注意非线性p值在变量p中的位置
legend("topright",
       paste0("P-overall ",ifelse(round(p[1],3) < 0.001,"< 0.001",round(p[1],3)),
              "\nP-non-linear = ",ifelse(round(p[2],3) < 0.001,"< 0.001",round(p[2],3))),
       bty="n",cex=0.8)
legend("bottomleft",lty = c(1,2),col = c("red","black"),
       c("Estimation","95% CI"),
       bty="n",cex=0.8)

输出图形如案例图形：