R绘制线性回归限制性立方样条图

接上一期关于logistic回归的限制性立方样条,本期介绍基于线性回归模型的限制性立方样条图。

变量要求:x为连续性变量,y为连续性变量。其他协变量既可以是分类变量,也可以是连续变量。

今天展示的是年龄BMI的影响,

自变量

因变量

协变量

age

BMI

地区、sex、睡眠时间

同样的,直接看数据形式和最终的效果图:

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

结果图如下:

.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)

#导入数据

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")

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

dd <- datadist(mydata)

options(datadist='dd')

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

##( bmi为y, age为x ,3是拟合曲线的时候采用三个节点)

##后面的+地区+sex+睡眠时间 是一些协变量

glm<-glm(bmi~rcs(age,3)+地区+sex+睡眠时间,data=mydata)

ols<-ols(bmi~rcs(age,3)+地区+sex+睡眠时间,data=mydata)

#线性模型可以用glm和ols两种拟合,两种结果一样,可以自己选择,如下图1

summary(glm)#glm这样查看

ols#ols直接这样查看

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

#这里也可以看到,地区展示了地区=2和地区=3的结果,因为前面我们设置地区参照组是 1

#性别展示sex=2的结果,因为前面我们设置sex参照组是 1

#睡眠时间因为是连续变量,因此只有1个估计值

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

##另外glm拟合的话无法进行预测,因此就用ols模型

fit3<-ols(bmi~rcs(age,3)+地区+sex+睡眠时间,data=mydata)

fit4<-ols(bmi~rcs(age,4)+地区+sex+睡眠时间,data=mydata)

fit5<-ols(bmi~rcs(age,5)+地区+sex+睡眠时间,data=mydata)

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

AIC(fit3)

AIC(fit4)

AIC(fit5)

#图片2

#3个节点模型的AIC最小,所以这里我们选择3个节点的模型

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

#使用a

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

an<-anova(fit)

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

an

########图片3

#查看age和bmi是否存在非线性关系

##生成预测值,线性模型估计本来就是Bata值,

##所以不需要采用fun=exp将bata值转化为or值了

plot(Predict(fit, age), anova=an, pval=T)

Bata<-Predict(fit, age,ref.zero = TRUE

#ggplot画图

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

p1

##进一步美化

########图片4

#anova=an, pval=T:增加F值和P值

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

  ##画曲线

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

  ##画置信区间

  geom_ribbon(data=Bata, 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="Bata (95%CI)")+

  #x轴范围

  scale_x_continuous(limits = c(40, 90),

                     #x轴刻度

                   breaks = c(40,50,60,70,80,90))+

  #y轴范围

  scale_y_continuous(limits = c(-500, 500),

                     #y轴刻度

                     breaks = c(-500,0,500))+

  ##手动给图上增加标签

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

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

p2

########图片5

#结果解释:

p=0.968,因此年龄和BMI不存在非线性关系

#另外,这里求大神解答,为什么图4把F值和P值放到图上了,但是图5没有??????????

#那么接下来,同样绘制性别分层的图

##计算不同性别的Bata值

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

               type="predictions",

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

#美化

p3<-ggplot()+

  ##画曲线,多color = sex

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

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

  ##画置信区间,多color = sex

  geom_ribbon(data=Bata1,

              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=26), colour="#BB0000", linetype="dashed")+

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

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

  #去除背景

  theme_classic()+

  ##增加标签

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

  ##x轴范围

  scale_x_continuous(limits = c(40, 90),

                     #x轴刻度

                     breaks = c(40,50,60,70,80,90))+

  ##y轴范围

  scale_y_continuous(limits = c(-500,500),

                     #y轴刻度

                     breaks = c(-500,0,500))+

  ##手动给图上增加标签

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

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

p3

########图6

同样男/女的年龄和bmi不存在关联。

但这样很不科学的,因为我们没有计算分性别的p值,

等以后讲讲分层分析如何计算p值的几种方法吧

#导出图片

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

       plot=p2,#哪张图

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

       #保存路径

       units="px",

       width = 1200,#宽度

       height = 800 #高度

)

ggsave(filename = "6.png",#命名

       plot=p3,#哪张图

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

       #保存路径

       units="px",

       width = 1200,#宽度

       height = 800 #高度

)

  • 26
    点赞
  • 28
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 2
    评论
前言: 看着同学做了个8x8x8的觉得不错,但是又觉得工程量太大成本太高,于是昨晚(15年5月8日)我就端着他的光立方看了十分钟,看透了原理之后回来当场就搭了这个2x2x2的,基于STC单片机设计。 先看下我的视频吧: 2x2x2光立方制作说明: 2片洞洞板用弯排针焊起来呈90°即可。电路连接是每一层共阴,给IO口低电平选通该层,然后每一列分别叫a,b,c,d,把这4个IO口模式设为推挽模式,强上拉输出点亮LED。我用的暖黄色LED八灯全亮时实测电流为34mA,STC12C单片机DIP20可以承受66mA的电流,所以不需要外围功率元件驱动。点击按键切换灯光花样,按钮接在外部中断0,所以任何时候按都灵光。 总共有1个全亮状态和10个灯光花样,而且基于有限状态机,可以随时自己增加灯光花样。物料成本大概就十来块钱,非常适合新手入门制作玩,在STC单片机最小系统之外只需要1个开关2颗电阻8颗LED即可完成。扔掉你的排成一条线的跑马灯吧,同样的8个LED,立起来之后马上整个档次都不一样了~ 这个电路还可以加个DS1302之类的时钟模块,做一个以8421码表示时间的钟,用4颗LED表示小时,分别是8,4,2,1,亮的灯加起来就是当前的小时。然后再用6颗LED表示分钟,分别是32,16,8,4,2,1,同理加起来就是当前的分钟~这个创意供各位参考,自己回去实现~只有自己看的懂也挺有意思。 2x2x2光立方实物: 2x2x2光立方源码部分截:

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

kaiming0000

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值