R语言入门--第七节(最小二乘回归建模)

以预测变量(自变量x)来预测响应变量(因变量y),通过生成一个等式,建立模型方程进行回归分析。主要内容是运用普通最小二乘(OLS)回归,进行简单线性回归、多项回归,以及发现并解决存在的偏差。

一、怎么做? lm() 拟合回归

1、简单线性回归(形如y=ax+b)

 women   #为身高与体重的数据表
fit <- lm(weight ~ height, data=women)  
#拟合简单线性回归,通过身高(x)去预测体重(y)
summary(fit)   #可以得到很多信息
summary(fit)
  • 如图Coefficients的Estimate列分别为截距b与回归系数a,即y=-87.52+3.45x
  • Pr(>|t|)即p值
  • Residual standard error 表示身高预测体重的平均误差为1.525;
  • Multiple R-squared即R²表示模型可以解释99.1%的方差;
  • ......
#观察下回归模型误差及绘图
women$weight   #实际值
fitted(fit)     #模型对应的预测值
residuals(fit)   #模型误差
confint(fit)   #提供模型参数的置信区间
plot(women$height,women$weight,  #实际数据的点图
     main="Women Age 30-39", 
     xlab="Height (in inches)", 
     ylab="Weight (in pounds)")
abline(fit)         #模型拟合曲线

注意:绘制模型拟合曲线,目前学习来看是在原有plot点图基础上,abline(fit)而成;而且由于abline只绘制直线,所以只适合用于简单回归。
如果直接plot(fit)绘制的模型诊断图,在后面会介绍到。

简单线性回归.png

补充:predict函数是用拟合模型对新的数据集预测响应变量值,样例为predict(fit, newdata) 。这里要注意的是newdata数据要是dataframe数据框格式,并且列名与建立fit时的预测变量名相同

height <- c(55, 65.5, 73)  #注意变量名
newdata <- data.frame(height)
newdata$weight <- predict(fit, newdata)

2、多项式回归(形如y=ax2+bx+c)

  • 当然也可以是更高次幂;目的是在某些情况下,提高拟合精度(曲线)。
  • 还以上个例子进行拟合回归,看看是否提高了精确度(R2)
fit2 <- lm(weight ~ height + I(height^2), data=women)  #拟合二次项等式
summary(fit2) 
plot(women$height,women$weight,
     main="Women Age 30-39",
     xlab="Height (in inches)",
     ylab="Weight (in lbs)")
lines(women$height,fitted(fit2))   #不能使用abline了
#从summary,以及绘图来看对于本数据,二次项确实能提高精度。
fit2

3、多元线性回归(形如y=ax+bz+c)

  • 不止一个预测变量,如上例有x,z两个
  • 某种角度来看,多项式回归是特殊的多元回归
  • state.x77 是美国各个州的一些数据的矩阵,我们利用它来进行犯罪率(Murder)与其它因素(Population人口,Illiteracy文盲率,Income收入,Frost结霜天数)的回归分析

3.1、变量间关系初步探索

states <- as.data.frame(state.x77[,c("Murder", "Population", 
                                     "Illiteracy", "Income", "Frost")])
cor(states)  #看看变量间的相关系数
library(car)
scatterplotMatrix(states, spread=FALSE, smoother.args=list(lty=2),
                  main="Scatter Plot Matrix")
  • 如下图,重点关注Murder行(第一行)可以看出谋杀率为一个双峰的曲线;随着人口、文盲率的增加而增加;随着收入水平和结霜天数的增加而下降。


    scatterplotMatrix.png

3.2 然后进行多元线性回归

fit3 <- lm(Murder ~ Population + Illiteracy + Income + Frost, data=states)
summary(fit3)
fit3.png
  • 此时的回归系数表示其他预测变量不变时,一个预测变量增加一个单位,因变量(谋杀率)增加的值。
  • 观察上图Pr|t|列中,Income与Frost回归系数不显著,关于变量的取舍在之后会专门叙述。

4、有交互项的多元线性回归

  • 形如y=ax+bz+cx:z 中,y与x的关系(相关系数)不是固定的,会随z变量水平变而变;同理y与z的关系也受x的影响.
  • 这时以mtcars数据,研究车mpg(y)与hp(x),wt(z)的关系,以及hp与wt间是否互相影响。
fit4 <- lm(mpg ~ hp + wt + hp:wt, data=mtcars) 
summary(fit)
fit4.png
  • 如上图Pr(>|t|)列中,显示hp与wt的交互是显著的,通过下面一个图可以清楚得表达
library(effects)
plot(effect("hp:wt", fit4,, list(wt=c(2.2, 3.2, 4.2))), multiline=TRUE)
#可以清晰看出在wt的三个水平下,mpg与hp的关系发生变化
#multiline选项默认为false,针对此例就会绘制3张图
effect plot.png

二、回归建得好不好?--回归诊断

  • 一般来说为满足最小二乘计算原理,数据要满足以下条件,回归模型才有意义

1、正态性:对于固定的自变量值(x),因变量值(y)要呈正态分布;
主要通过检验模型预测结果的残差值是否符合正态分布。
2、独立性:y值之间相互独立;
一般从收集过程中确定
3、线性:因变量与自变量之间为线性相关;
若线性相关,则预测值与对应的残差值没有关系,随机分布
4、同方差性:因变量的方差不随自变量的水平不同而不同;
若同方差,则预测值与标准化残差值也是随机分布关系。

  • 所谓的回归诊断就是对上面四个方面进行检验,方法不少,具体如下

1、基础标准plot(fit)方法

  • 还是那个身高预测体重的例子
opar <- par(no.readonly=TRUE)
fit <- lm(weight ~ height, data=women)
par(mfrow=c(2,2))
plot(fit)  #生成评价模型拟合情况的四幅图
par(opar)
plot(fit).png
  • 上四图分别进行了四方面的检验:

(1) Normal Q-Q图(右上)--正态性检验:若满足正态假设,那么图上的点应该落在呈45度角的直线上。如图,还是有一部分点离线比较远的,尤其是被标注的点1,点15。
(2)残差图与拟合图(左上)--线性:以预测体重值数据为x值,对应的残差值绘点图,并进行拟合。若满足因变量与自变量线性相关,拟合曲线应贴合水平,点随机均匀分布在两侧。本图为拟合曲线,暗示可能要加上一个二次项
(3)位置尺度图(左下)--同方差性:若满足同方差性(不变方差假设),则点也应在落在线两侧随机分布,本图较符合。
(4)残差杠杆图(右下)--重点观测点:A:离群点:有较高残差的点,一般标准化残差值绝对值大于2的都可能是离群点,对应本图就是纵坐标绝对值大于2的;B:高杠杆值点:异常的观测值的组合,恒量标准为“帽子统计量”=p/n(p为length(coefficients(fit)),n为样本量),大于2倍或者3倍p/n的,可视为高杠杆值点。对于本图,p/n=2/15=0.133,所有点横坐标没有大于0.26的,故没有高杠杆值;C:强影响点:对模型参数评估影响过大的点。对于本图中就是虚线范围内的点(点15与点1)
对于这些低质量点,删除后可能会得到拟合效果更好的模型。但是要谨慎,合理,因为原则上应该是模型去匹配数据,而不是相反。

#对二次项回归拟合作图,观察两组图的区别
opar <- par(no.readonly=TRUE)
fit2 <- lm(weight ~ height + I(height^2), data=women)
par(mfrow=c(2,2))
plot(fit2)   #观察前后四幅图的区别。
par(opar)
plotfit2.png

2、car包诊断方法

  • 第一次使用,需要安装,加载;
  • 针对每个条件,有不同函数功能专门检验,绘图;

2.1、正态性--qqplot() 学生化残差图

library(car)
states <- as.data.frame(state.x77[,c("Murder", "Illiteracy")])  #分析对象需要是数据框格式
fit <- lm(Murder ~ Illiteracy, data=states)
summary(fit)
qqPlot(fit, labels=row.names(states), id.method="identify",
       simulate=TRUE, main="Q-Q Plot")
  • 结果如下图,基本所有点(除了被标注的两个点)都离直线很近,并落在置信区间内,表明正态性假设符合的很好。


    qqplot.png

补充:此外也可以用residplot() 函数生成残差柱状图更形象地观察。代码如下——

residplot <- function(fit, nbreaks=10) {
        z <- rstudent(fit)
        hist(z, breaks=nbreaks, freq=FALSE,
             xlab="Studentized Residual",
             main="Distribution of Errors")  #绘制残差直方图
        rug(jitter(z), col="brown")       #绘制查查轴须图
        curve(dnorm(x, mean=mean(z), sd=sd(z)),
              add=TRUE, col="blue", lwd=2)     #标准正态分布图
        lines(density(z)$x, density(z)$y,       
              col="red", lwd=2, lty=2)           #残差的核密度图
        legend("topright",               
               legend = c( "Normal Curve", "Kernel Density Curve"),
               lty=1:2, col=c("blue","red"), cex=.7)         #添加标签
}
residplot(fit)  
  • 结果如下图,密度曲线较好地与正态分布图贴合在一起,除了尾巴的一小部分。


    残差直方图.png

2.2、因变量值(或残差)的独立性检验

  • 因变量值是否独立,最好的检验方式是依据收集数据方式时确立的;这里car包也提供了一种方法
durbinWatsonTest(fit)
  • 返回p值大于0.05,则说明因变量值无自相关性,残差项之间独立;
  • 该检验方法适用于时间独立的数据,对于非聚集型的数据不适用(没太理解,存疑);

2.3、线性检验

crPlots(fit) 
  • 该函数对每一个预测变量都会绘制一个成分残差图。若图形存在非线性,表示建模需要进一步改进。

2.4、同方差检验

ncvTest(fit)
  • 该函数生成一个计分检验;零假设为误差方差不变,备择假设为误差随着拟合值变化而变化。若检验显著(p>0.05),则验证了备择假设,即残差方差不恒定。而我们一般是希望p大于0.05

3、综合验证法gvlma()包

library(gvlma)
gvmodel <- gvlma(fit) 
summary(gvmodel)
  • 观察p-value值大于0.05,说明满足假设条件,建模成功。若Decision下的文字表明违反了假设条件(p<0.05),可以使用前几节的专项方法判断哪些假设(哪些点)没有被满足。
  • 比如上面那个身高体重的例子,存在p<0.05的点,在单独检查每一项假设后,删除相关点,使得Decision全部合格。

4、异常观测点

  • 之前在标准方法里简单介绍了三种异常值的判断方法,下面有一些专门的方法提供判断。

4.1离群点

  • 残差过大的点
library(car)
outlierTest(fit)
  • 返回结果,若不显著(p>0.05),即没有离群点;若显著,因为一次检验只能显示一个,若需要将该点删除后,再检验有没有其它的离群点的存在。

4.2高杠杆值

  • 一般来说观测点的帽子点的均值大于帽子均值(p/n)的2或3倍,就可认定为高杠杆值点;
hat.plot <- function(fit) {
  p <- length(coefficients(fit))   #参数数目(包括截距项)
  n <- length(fitted(fit))    #样本量
  plot(hatvalues(fit), main="Index Plot of Hat Values")
  abline(h=c(2,3)*p/n, col="red", lty=2)
  identify(1:n, hatvalues(fit), names(hatvalues(fit)))
}
hat.plot(fit)  #实现交互模式进行对重点关注点的标注
hat statistic.png
  • 如上图 Louisiana点最异常,高杠杆值点可能是强影响点,也可能不是,要看它们是否是离群点。

4.3、强影响点

  • Cook距离或称为D统计量>4/(n-k-1) 则为强影响点。
cutoff <- 4/(nrow(states)-length(fit$coefficients)-2) 
#是减2而不是减1的原因是因为length(fit$coefficients)是预测变量数目加上截距项了,需要减去1
plot(fit, which=4, cook.levels=cutoff)
abline(h=cutoff, lty=2, col="red")
#红线以上的点为强影响点。
Cook距离.png
  • 如上图,Neveda点为强影响点,若删除该点会导致回归模型的截距项和斜率发生显著变化。
summary(fit)
fit <- lm(Murder ~ Illiteracy, data=states[-c(28),])
summary(fit)

4.4、异常点综合观察

  • 在plot() 函数绘制的四张图的第四张图中,其实就是综合观察图,可能可读性不高,还有另外一种方法。
  • car包的influencePlot() 函数
library(car)
influencePlot(fit, id.method="identify", main="Influence Plot", 
              sub="Circle size is proportial to Cook's Distance" )
  • 离群点是纵坐标绝对值大于2的点;
  • 高杠杆值点是横坐标大于2或3倍的点;
  • 圆圈大小正比于影响程度,越大的点就是造成不成比例影响的强影响点。
influencePlot.png

三、建得不好怎么办?--改进&选最好

1、改进措施

1.1、删除观测点(离群点与离群点)

states <- as.data.frame(state.x77[,c("Murder","Illiteracy")])
Num=c(1:50)
state2=cbind(states,Num)
fit <- lm(Murder ~ Illiteracy, data=states[-c(28),]) #删除Nevada观测点
summary(fit)

1.2、变量变换

  • 法1:yⁿ代替y,n常见为-2、-1、-0.5、0.5、1、2等,还有log(y);
  • 法2:若y是比例数,通常使用logit变换[In(Y/1-Y)];
  • 变量变换要谨慎,要能解释出意义。

1.3、增删变量

  • 比如直线无法精确拟合,可以增加一个二次项精确拟合。

2选择“最佳”

2.1、比较那个模型(方程)好

  • 在前面murder的多元回归时,Income与Frost的Pr(>|t|)值不显著(过大),从而产生这样一个疑问,是否有必要加入这两个变量——
法1:anova()函数
states <- as.data.frame(state.x77[,c("Murder", "Population",
                                     "Illiteracy", "Income", "Frost")])
fit1 <- lm(Murder ~ Population + Illiteracy + Income + Frost,
           data=states)
fit2 <- lm(Murder ~ Population + Illiteracy, data=states)
anova(fit2, fit1)
#拿模型1嵌套如模型2中,返回p值不显著(>0.05),提示不需要将这两个变量加入模型中来。
#法2:AIC法
fit1 <- lm(Murder ~ Population + Illiteracy + Income + Frost,
           data=states)
fit2 <- lm(Murder ~ Population + Illiteracy, data=states)
AIC(fit1,fit2)
#AIC值较小的模型优先选择。

2.2、变量选择

从大量候选变量选择最终的候选预测变量

(1)逐步回归

  • 原理:模型每次会一次添加或者删除一个变量,直到达到某个标准;
  • 评价标准为AIC值,越小越好;
  • 方法有向前(添加)与向后(删除)逐步回归。
states <- as.data.frame(state.x77[,c("Murder", "Population",
                                     "Illiteracy", "Income", "Frost")])
fit <- lm(Murder ~ Population + Illiteracy + Income + Frost,
          data=states)
stepAIC(fit, direction="backward")
#最后一项结果表明保留Population与Illiteracy,质量最优。但因为并不是所有可能都被评价,所以存在争议,下一个方法避免了这一问题。

(2)全子集回归

  • 即所有可能的模型都会被检验;
  • 通过leaps包的regsubsets()函数实现
library(leaps)
states <- as.data.frame(state.x77[,c("Murder", "Population",
                                     "Illiteracy", "Income", "Frost")])
leaps <-regsubsets(Murder ~ Population + Illiteracy + Income +
                     Frost, data=states, nbest=4)
plot(leaps, scale="adjr2")
regsubsets.png
  • 如上图结果表明,最高一行所包含的变量数目为最佳模型

四、深层次分析

1、k重交叉验证(训练集与验证集)-- 评价拟合能力

  • 将一定比例的数据挑选出来作为训练样本,其它的样本作为验证集;先在训练样本上获取回归方程,然后在验证集预测、比较
  • 所谓k重,就是原样本分为k个子样本,轮流将k-1子样本组合作为训练集,剩余1个子样本作为验证集;这样就会获得k个预测方程,预测求平均,得出模型预测效果。
    首先定义一个函数,主要用到bootstrap包的crossval函数
shrinkage <- function(fit,k=10){
  require(bootstrap)
  
  # define functions 
  theta.fit <- function(x,y){lsfit(x,y)}
  theta.predict <- function(fit,x){cbind(1,x)%*%fit$coef} 
  
  # matrix of predictors
  x <- fit$model[,2:ncol(fit$model)]
  # vector of predicted values
  y <- fit$model[,1]
  
  results <- crossval(x,y,theta.fit,theta.predict,ngroup=k)
  r2 <- cor(y, fit$fitted.values)**2 # raw R2 
  r2cv <- cor(y,results$cv.fit)**2 # cross-validated R2
  cat("Original R-square =", r2, "\n")
  cat(k, "Fold Cross-Validated R-square =", r2cv, "\n")
  cat("Change =", r2-r2cv, "\n")
}

然后用于评价模型

states <- as.data.frame(state.x77[,c("Murder", "Population",
                                     "Illiteracy", "Income", "Frost")])
fit <- lm(Murder ~ Population + Illiteracy + Income + Frost,
          data=states)
shrinkage(fit)

如下图返回信息包括:
(1)模型原始R2值
(2)经过k重验证的R2值
(3)上述两者的差值
一般来说,经过k重验证的R2值低于原始模型值,因为k重验证更公平、合理。当R2差值越低,即经过k重验证的R2值略低于原始值时,原始模型越准确。因此是一个评价模型的方法。

shrinkage(fit)
fit2 <- lm(Murder ~ Population + Illiteracy ,
          data=states)
shrinkage(fit2)
#如图,仅降低0.04
shrinkage(fit2)

2、评价预测变量相对重要性

由于可能存在交互关系,不能直接根据建模回归系数评价。其实方法有很多,最简单的是比较标准化的回归系数。
简单来说将原始数据标准化(mean=0,sd=1),再进行R回归,此时根据得到的回归系数大小,即可评价预测变量的重要性。越大越重要。

states <- as.data.frame(state.x77[,c("Murder", "Population",
                                     "Illiteracy", "Income", "Frost")])
zstates <- as.data.frame(scale(states))
fit <- lm(Murder ~ Population + Illiteracy + Income + Frost,
           data=zstates)
coef(fit)

如下图,可认为Illiteracy为最重要的预测变量。


coef(fit)

综上是一些关于回归的R操作知识,由于相关的统计原理不是太了解,仅记录了操作。如有错误,敬请指正。教材参考自《R语言实战(第二版)》

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 212,454评论 6 493
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,553评论 3 385
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 157,921评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,648评论 1 284
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,770评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 49,950评论 1 291
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,090评论 3 410
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,817评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,275评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,592评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,724评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,409评论 4 333
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,052评论 3 316
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,815评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,043评论 1 266
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,503评论 2 361
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,627评论 2 350

推荐阅读更多精彩内容