R绘制基于Cox回归模型的限制性立方样条图

R绘制基于Cox回归模型的限制性立方样条图

上两期分享了线性回归和logistic回归模型的限限制性立方样条图，那么这一期继续分享基于Cox回归的限制性立方样条的R实现。

应用场景：流行病学队列研究或实验性研究都可以用，原因在于无论是队列研究或实验性研究，都需要进行随访，这时候就会多出来一个时间变量，也就是研究对象从入组到出组或发生结局时间或其他原因无法继续随访的时间，流行病学称为生存时间。

变量要求：x为连续性变量，y是两个变量：生存时间和结局变量（如：发病、死亡、是否治愈等等），所有结局变量为二分类变量。

今天来分享年龄对心血管风险的影响

自变量	因变量	协变量
age	心血管、生存时间	地区、sex、bmi

老规矩，直接看数据形式和最终的效果图：

数据情况：这里展示前几行

结果图：

数据用的其实就是原始数据，下面直接说明怎么绘制吧！！

同样，注意两个##的地方代码就是需要更改的地方

其实主要修改的地方就是拟合模型的代码：

fit<-cph(Surv(生存时间,心血管) ~ rcs(bmi,3)+地区+sex+age,data=mydata)

其他地方基本和前面两期是一样

.libPaths()#查看R包位置

##这里改成自己电脑的路径

setwd("C:/Users/12974/Desktop/百度经验/简书/R绘制限制性立方样条图")#设置工作空间

getwd()#加载工作空间

#包安装

install.packages("foreign")

install.packages("ggplot2")

install.packages("rms")

install.packages("survival")

install.packages("Hmisc")

install.packages("splines")

#批量包加载

ps <- c("foreign","ggplot2","rms","survival","Hmisc","splines")

for(i in ps){library(i, character.only = T)}; rm(i)

library(survival)

#导入数据

mydata <- read.csv("cc1.csv",as.is = TRUE,header = T,sep = ",", fileEncoding='utf-8')

names(mydata)#查看所有变量名字

attach(mydata)

#变量因子化，意思就是把分类变量变为真正的分类变量

##地区、sex需要

mydata$地区<-as.factor(mydata$地区)

mydata$sex<-as.factor(mydata$sex)

##设置分类变量的参照组

mydata$地区<-relevel(mydata$地区, ref="1")

mydata$sex<-relevel(mydata$sex, ref="1")

#注意：这里我说明一下，结局变量心血管：值是1/0；

#其实不设置R默认以“0“为参照

#这里我不再用上述方法设置y的参照组了，

原因在于后面拟合生存分析的R包要求因变量必须是数值的，

如果按照上述操作的话，就会变成字符变量了，模型会出错的

#接着为后续程序设定数据环境，也就是打包数据，这一步在预测模型中也常做

dd <- datadist(mydata)

options(datadist='dd')

##下面是设置立方样条x的参照点，参照点的值对应的HR=1

dd$limits$age[2]<-60

#这句刚开始可以先不运行，等下面立方样条预测好之后

自己查看HR=1时，对应的X是多少，本例HR=1,age=60

后面都有介绍；一定注意这里先不要设置参照点，先

用模型大概得出转折点后，再根据专业知识进行综合设置

#拟合Cox回归的限制性立方样条

##（心血管 生存时间为y ， age 为x ，3是拟合曲线的时候采用三个节点）

##后面的+地区+sex+bmi 是一些协变量

fit<-cph(Surv(生存时间,心血管) ~ rcs(age,3)+地区+sex+bmi,data=mydata)

#这里先看看结果#这里先看看结果#这里先看看结果

fit

#1.构建模型。【节点数为3.4.5均进行了构建和比较】

##由于限制性立方样条推荐拟合3~5个节点，这里分别拟合3个模型

fit3<-cph(Surv(生存时间,心血管) ~ rcs(age,3)+地区+sex+bmi,data=mydata)

fit4<-cph(Surv(生存时间,心血管) ~ rcs(age,4)+地区+sex+bmi,data=mydata)

fit5<-cph(Surv(生存时间,心血管) ~ rcs(age,5)+地区+sex+bmi,data=mydata)

#然后查看AIC,选择AIC最小的

AIC(fit3)

AIC(fit4)

AIC(fit5)

##########图片1

#最后我选择fit3，3个节点

fit<-update(fit3)#更新模型

#使用anova()可以看p值,这里是为后续图上放 卡方值和P值 做准备

an<-anova(fit)

#这个结果主要是看bmi对心血管非线性关系的p值，可以发现二者存在非线性关系

an

########图片2

#年龄和心血管存在非线性关系

##生成预测值，并作图 （exp相当于把预测值转换成了HR）

plot(Predict(fit, age,fun=exp,ref.zero = TRUE), anova=an, pval=T)

HR<-Predict(fit, age,fun=exp,ref.zero = TRUE)

#运行完这句后，查看数据HR

########图片3

#可以看到HR=1时，age大概是60

回到前面，设置立方样条x的参照点那块，将参照点设为60，再跑一遍模型

########图片4

#ggplot画图

ggplot(HR,anova=an, pval=T)

#进一步美化

#anova=an, pval=T：增加卡方值和P值

p1<-ggplot(anova=an, pval=T)+

  #画曲线

  geom_line(data=HR, aes(age,yhat),linetype=1,size=1,alpha = 0.9,colour="red")+

  #画置信区间

  geom_ribbon(data=HR, aes(age,ymin = lower, ymax = upper),alpha = 0.3,fill="red")+

  #x轴任意刻度：增加一条竖线

  geom_vline(aes(xintercept=60), colour="#BB0000", linetype="dashed")+

  #y轴任意刻度：增加一条横线

  geom_hline(yintercept=1, linetype=2,size=1)+

  #去除背景

  theme_classic()+

  ##增加标签

  labs(title = "RCS", x="age", y="HR (95%CI)")+

  ##x轴范围

  scale_x_continuous(limits = c(30, 90),

                     #x轴刻度  seq(30,90,10)函数，

                     #分别是最小值30，最大值90，间距10

                     

                     breaks = seq(30,90,10))+

  #y轴范围

  scale_y_continuous(limits = c(0, 2),

                     #y轴刻度，seq(0,2,0.5)函数，

                     #分别是最小值0，最大值2，间距0.5

                     breaks = seq(0,2,0.5))+

  ##手动给图上增加标签

  geom_text(aes(x=60,y=1,label='age=60'),

            vjust=1.5,hjust=0,size=2.5)

p1

########结果图1

#结果解释：

随着age增加，心血管风险增加，当BMI>60,心血管风险进一步提高；

由于是模拟的数据，可能和实际不符，这里仅供参考

#那么接下来，绘制性别分层的图

##计算不同性别的OR值

HR1 <- Predict(fit, age, sex=c('1','2'),

               fun=exp,type="predictions",

               ref.zero=TRUE,conf.int = 0.95,digits=2)

#美化

p2<-ggplot()+

  #画曲线，多color = sex

  geom_line(data=HR1, aes(age,yhat, color = sex),

            linetype="solid",size=1,alpha = 0.9)+

  #画置信区间，多color = sex

  geom_ribbon(data=HR1,

              aes(age,ymin = lower, ymax = upper,fill = sex),

              alpha = 0.2)+

  #两条线的颜色

  scale_color_manual(values = c('red','blue'))+

  #两个置信区间的颜色

  scale_fill_manual(values = c("red","blue"))+

  #x轴任意刻度：增加一条竖线

  geom_vline(aes(xintercept=60), colour="#BB0000", linetype="dashed")+

  #x轴任意刻度：再增加一条竖线

  geom_vline(aes(xintercept=70), colour="#BB0000", linetype="dashed")+

  #y轴任意刻度：增加一条横线

  geom_hline(yintercept=1, linetype=2,size=1)+

  #去除背景

  theme_classic()+

  #增加标签

  labs(title = "RCS", x="bmi", y="OR (95%CI)")+

  ##x轴范围

  scale_x_continuous(limits = c(30, 90),

                     #x轴刻度  seq(30,90,10)函数，

                     #分别是最小值30，最大值90，间距10

                     

                     breaks = seq(30,90,10))+

  #y轴范围

  scale_y_continuous(limits = c(0, 2),

                     #y轴刻度，seq(0,2,0.5)函数，

                     #分别是最小值0，最大值2，间距0.5

                     breaks = seq(0,2,0.5))+

  ##手动给图上增加标签

  geom_text(aes(x=50,y=1,label='age=60'),

            vjust=1.5,hjust=0,size=2.5)+

  ##手动给图上增加标签

  geom_text(aes(x=70,y=0.9,label='age=70'),

            vjust=1.5,hjust=0,size=2.5)

p2

########结果图2

可以看到男性和女性的结果与前面基本一致

#导出图片

ggsave(filename = "结果1.png",#命名

       plot=p1,#哪张图

       path = "C:/Users/12974/Desktop/百度经验/简书/R绘制限制性立方样条图",

       #保存路径

       units="px",

       width = 1200,#宽度

       height = 800 #高度

)

ggsave(filename = "结果2.png",#命名

       plot=p2,#哪张图

       path = "C:/Users/12974/Desktop/百度经验/简书/R绘制限制性立方样条图",

       #保存路径

       units="px",

       width = 1200,#宽度

       height = 800 #高度

)