R语言mgcv包广义可加模型对分类曲线进行拟合

广义可加模型(generalized additive models，GAMs)是广义线性模型和可加模型的结合，由 Hastie T 和 Tibshirani Ｒ于1986 年首先提出，其不要求应变量与自变量满足线性关系，适用于非线性数据的研究。

发本文章的起因为收到粉丝投稿要求我做个这样的图，来自于2017年发表在Eur Urol期刊（SCI IF=17.9分）。The Impact of Local Treatment on Overall Survival in Patients with Metastatic Prostate Cancer on Diagnosis: A National Cancer Data Base Analysis. Eur Urol, 2017.


前段时间我已经发表了一篇文章《利用广义可加模型对分类数据进行曲线拟合》，那时是使用vgam包拟合的，后面查资料突然发现vgam包的vgam函数和mgcv包的gam函数还是有区别的，最主要的一个是vgam函数不能进行交互分析，做出来的图和gam函数还是有区别的，因此重发一篇。这次重新用了一个体检数据，我们来进行分析一下，首先导入数据

ac1<-read.csv("E:/r/test/tijian.csv",sep=',',header=TRUE)
library(mgcv)
library(data.table)
library(ggplot2)
1
2
3
4

数据变量很多，我解释几个我等下要用的，HBP：是否发生高血压，结局指标，AGE：年龄，是我们的协变量，ALH：某种治疗方案，分为0和1。等下我们要观察的是不同治疗方案下，随着年龄增加，高血压发生率的变化。
把ALH转成分类变量

ac1$ALH<-as.factor(ac1$ALH)
1

建立模型

mgam.lr1<-gam(HBP~ALH+s(AGE,k=3),family = binomial(link = "logit"),
              data = ac1)
1
2

解析模型

summary(mgam.lr1)
1

截距项Intercept的Z=-1.1337，P小于0.05，表明截距项有统计学意义，s(AGE)和
s(AGE)的P值小于0.05，表明这两个变量和结局具有某种非线性关系。
先看一下没有分类的

plot(mgam.lr1,se=T)
1

表明随着age增大，高血压发病状态改变增大。接下来我们进行数据提取

提取数据后生成预测值

newdat$yhat<-predict(mgam.lr1,newdata=newdat,type="response")
1

生成预测值就可以绘图了

ggplot(newdat,aes(AGE,yhat,col=ALH))+
  geom_line(size=2)+
  scale_color_viridis(discrete=T)+
  xlab("age")+
  ylab("hbp率")+
  coord_cartesian(xlim = range(ac1$AGE),
                  ylim = c(0,1),
                  expand = F)
1
2
3
4
5
6
7
8

美化一下图形

ggplot(newdat,aes(AGE,yhat,col=ALH))+
  geom_line(size=2)+
  scale_color_viridis(discrete=T)+
  xlab("sge")+
  ylab("hbp")+
  coord_cartesian(xlim = range(ac1$AGE),
                  ylim = c(0,1),
                  expand = F)+
  theme_bw()+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank())+
  theme(legend.position = c(.8,.2),
        legend.key.width = unit(2,"cm"))
1
2
3
4
5
6
7
8
9
10
11
12

这样一个用于发表的图形就做好了，是不是和上面的论文的图形一模一样呀，

我们还可以找出它的交点进行标注，最简单的就是从数据集照0的预测值本来是小于1的，然后突然大于1了，这就是交点。也可以自己写个函数来找，我这里大概是在45.6这个位置。

画条竖线标记一下，表明age超过46.5后，ALH0这一组的高血压发生率超过了ALH1的这一组

ggplot(newdat,aes(AGE,yhat,col=ALH))+
  geom_line(size=2)+
  geom_vline(aes(xintercept=45.6),colour="#BB0000", linetype="dashed")+#添加竖线
  scale_color_viridis(discrete=T)+
  xlab("age")+
  ylab("hbp")+
  coord_cartesian(xlim = range(ac1$AGE),
                  ylim = c(0,1),
                  expand = F)+
  theme_bw()+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank())+
  theme(legend.position = c(.8,.2),
        legend.key.width = unit(2,"cm"))
1
2
3
4
5
6
7
8
9
10
11
12
13

我们还可以重抽样获取数据可信区间

绘图

ggplot(newdat,aes(AGE,yhat))+
  geom_ribbon(aes(ymin=ll,ymax=ul,fill=ALH),alpha=.2)+
  geom_line(aes(col=ALH),size=2)+
  scale_color_viridis(discrete=T)+
  scale_fill_viridis(discrete=T)+
  xlab("age")+
  ylab("hbp")+
  coord_cartesian(xlim = range(ac1$AGE),
                  ylim = c(0,1),
                  expand = F)+
  theme_bw()+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank())+
  theme(legend.position = c(.8,.2),
        legend.key.width = unit(2,"cm"))
1
2
3
4
5
6
7
8
9
10
11
12
13
14

最后生成最终图形

OK，本章结束觉得有用的话多多分享哟。
原创不易，需要文章数据和全部代码的朋友，请把本文章转发朋友圈集10个赞，截图发给我，嫌麻烦的给我打赏5元截图发给我也可以。