一、线性回归模型假设条件
我们接着上篇文章开始讲解线性模型诊断方面的操作。我们说过,线性模型的参数估计采用了最小二乘法的思想,但基于该思想是有前提假设的:
1)正态性假设:随机误差项服从均值为0,标准差为sigma的正态分布;
2)独立性:因变量y之间相互独立,即互不影响;
3)线性关系:因变量与自变量之间必须满足线性相关;
4)同方差性:随机误差项满足方差齐性;
只有线性模型满足以上几个假设条件,通过最小二乘法得到的结果才可能比较准确。
首先看一下多元线性模型的参数估计:
>str(as.data.frame(state.x77))
'data.frame': 50 obs. of 8 variables:
$ Population: num 3615 365 2212 2110 21198 ...
$ Income : num 3624 6315 4530 3378 5114...
$ Illiteracy: num 2.1 1.5 1.8 1.9 1.1 0.7 1.1 0.9 1.3 2 ...
$ Life Exp : num 69 69.3 70.5 70.7 71.7 ...
$ Murder : num 15.1 11.3 7.8 10.1 10.3 6.83.1 6.2 10.7 13.9 ...
$ HS Grad : num 41.3 66.7 58.1 39.9 62.663.9 56 54.6 52.6 40.6 ...
$ Frost : num 20 152 15 65 20 166 139 10311 60 ...
$ Area : num 50708 566432 113417 51945156361 ...
> my.data <-as.data.frame(state.x77[, c(1, 2, 3, 4, 5, 6)])
> fit <-lm(Murder~., data=my.data)
> summary(fit)
Call:
lm(formula = Murder~ ., data = my.data)
Residuals:
Min 1Q Median 3Q Max
-3.6960 -1.1351 0.0498 1.3554 3.3204
Coefficients:
Estimate Std. Error t valuePr(>|t|)
(Intercept) 1.186e+02 1.749e+01 6.779 2.41e-08 ***
Population 2.264e-04 6.168e-05 3.670 0.000653 ***
Income -1.186e-05 5.689e-04 -0.021 0.983469
Illiteracy 2.604e+00 5.957e-01 4.371 7.44e-05 ***
`Life Exp` -1.686e+00 2.498e-01 -6.751 2.65e-08 ***
`HS Grad` 8.217e-02 5.191e-02 1.583 0.120615
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’1
Residual standarderror: 1.794 on 44 degrees of freedom
MultipleR-squared: 0.7879, Adjusted R-squared: 0.7638
F-statistic: 32.68on 5 and 44 DF, p-value: 9.203e-14
该模型除了Income和HS Grad变量没有通过显著性检验以外,剩余变量都是显著的,并且模型也通过检验,5个自变量解释了79%的因变量,似乎模型还能说的过去。接下来就对该模型做进一步的验证。
> str(fit)
List of 12
$ coefficients : Named num [1:6] 1.19e+022.26e-04 -1.19e-05 2.60 -1.69 ...
..- attr(*, "names")= chr [1:6]"(Intercept)" "Population" "Income""Illiteracy" ...
$ residuals : Named num [1:50] 3.32 0.202 -1.721 2.009 -0.103 ...
..- attr(*, "names")= chr [1:50]"Alabama" "Alaska" "Arizona" "Arkansas"...
$ effects : Named num [1:50] -52.17 8.88 7.97 -15.37 -11.81 ...
..- attr(*, "names")= chr [1:50]"(Intercept)" "Population" "Income""Illiteracy" ...
$ rank : int 6
$ fitted.values: Named num [1:50] 11.78 11.19.52 8.09 10.4 ...
..- attr(*, "names")= chr [1:50]"Alabama" "Alaska" "Arizona" "Arkansas"...
$ assign : int [1:6] 0 1 2 3 4 5
$ qr :List of 5
..$ qr : num [1:50, 1:6] -7.071 0.141 0.141 0.141 0.141 ...
.. ..- attr(*, "dimnames")=List of2
.. .. ..$ : chr [1:50] "Alabama""Alaska" "Arizona" "Arkansas" ...
.. .. ..$ : chr [1:6] "(Intercept)""Population" "Income" "Illiteracy" ...
.. ..- attr(*, "assign")= int [1:6]0 1 2 3 4 5
..$ qraux: num [1:6] 1.14 1.12 1.03 1.08 1.02...
..$ pivot: int [1:6] 1 2 3 4 5 6
..$ tol : num 1e-07
..$ rank : int 6
..- attr(*, "class")= chr"qr"
$ df.residual : int 44
$ xlevels : Named list()
$ call : language lm(formula = Murder ~ ., data = my.data)
$ terms :Classes 'terms', 'formula' length 3 Murder ~ Population + Income +Illiteracy + `Life Exp` + `HS Grad`
.. ..- attr(*, "variables")=language list(Murder, Population, Income, Illiteracy, `Life Exp`, `HS Grad`)
.. ..- attr(*, "factors")= int[1:6, 1:5] 0 1 0 0 0 0 0 0 1 0 ...
.. .. ..- attr(*, "dimnames")=Listof 2
.. .. .. ..$ : chr [1:6] "Murder""Population" "Income" "Illiteracy" ...
.. .. .. ..$ : chr [1:5]"Population" "Income" "Illiteracy" "`LifeExp`" ...
.. ..- attr(*, "term.labels")= chr[1:5] "Population" "Income" "Illiteracy""`Life Exp`" ...
.. ..- attr(*, "order")= int [1:5]1 1 1 1 1
.. ..- attr(*, "intercept")= int 1
.. ..- attr(*, "response")= int 1
.. ..- attr(*,".Environment")=
.. ..- attr(*, "predvars")=language list(Murder, Population, Income, Illiteracy, `Life Exp`, `HS Grad`)
.. ..- attr(*, "dataClasses")=Named chr [1:6] "numeric" "numeric" "numeric""numeric" ...
.. .. ..- attr(*, "names")= chr[1:6] "Murder" "Population" "Income""Illiteracy" ...
$ model :'data.frame': 50 obs. of 6 variables:
..$ Murder : num [1:50] 15.1 11.3 7.8 10.1 10.3 6.8 3.1 6.2 10.7 13.9 ...
..$ Population: num [1:50] 3615 365 2212 211021198 ...
..$ Income : num [1:50] 3624 6315 4530 3378 5114 ...
..$ Illiteracy: num [1:50] 2.1 1.5 1.8 1.91.1 0.7 1.1 0.9 1.3 2 ...
..$ Life Exp : num [1:50] 69 69.3 70.5 70.7 71.7 ...
..$ HS Grad : num [1:50] 41.3 66.7 58.1 39.9 62.6 63.9 56 54.6 52.6 40.6 ...
..- attr(*, "terms")=Classes'terms', 'formula' length 3 Murder ~ Population + Income + Illiteracy + `LifeExp` + `HS Grad`
.. .. ..- attr(*, "variables")=language list(Murder, Population, Income, Illiteracy, `Life Exp`, `HS Grad`)
.. .. ..- attr(*, "factors")= int[1:6, 1:5] 0 1 0 0 0 0 0 0 1 0 ...
.. .. .. ..- attr(*,"dimnames")=List of 2
.. .. .. .. ..$ : chr [1:6]"Murder" "Population" "Income""Illiteracy" ...
.. .. .. .. ..$ : chr [1:5]"Population" "Income" "Illiteracy" "`LifeExp`" ...
.. .. ..- attr(*, "term.labels")=chr [1:5] "Population" "Income" "Illiteracy""`Life Exp`" ...
.. .. ..- attr(*, "order")= int[1:5] 1 1 1 1 1
.. .. ..- attr(*, "intercept")= int1
.. .. ..- attr(*, "response")= int1
.. .. ..- attr(*,".Environment")=
.. .. ..- attr(*, "predvars")=language list(Murder, Population, Income, Illiteracy, `Life Exp`, `HS Grad`)
.. .. ..- attr(*, "dataClasses")=Named chr [1:6] "numeric" "numeric" "numeric""numeric" ...
.. .. .. ..- attr(*, "names")= chr[1:6] "Murder" "Population" "Income""Illiteracy" ...
- attr(*, "class")= chr"lm"
1、模型残差的正态性假设的两种方法:
方法一:正态性检验:使用自定义函数plotErrors(也可以使用自定义函数的norm.test)
> plotErrors<- function(forecasterrors)
+ {
+ # make a red histogram of the forecast errors:
+ mysd <- sd(forecasterrors)
+ hist(forecasterrors,col="red", freq=FALSE) 画出模型残差的直方图
注意:下面几句命令可以使用此命令代替
lines(density(forecasterrors),col="blue", type="l", lwd=2)
+ # freq=FALSE ensures the area under the histogram = 1
+ # generate normally distributed data with mean 0 and standard deviation mysd
+ mynorm <- rnorm(10000,mean=0, sd=mysd) 生成10000个均值为0,方差为模型残差的方差的正态分布数据
+ myhist <-hist(mynorm, plot=FALSE)
+ # plot the normal curve as a blue line on top of the histogram of forecast errors:
+ points(myhist$mids,myhist$density, type="l", col="blue", lwd=2)
+ }
>plotErrors(fit$residuals)
>qqnorm(fit$residuals)
>qqline(fit$residuals)
方法二:使用自定义函数的norm.test
有关norm.test自定义函数的脚本可以到此处下载:http://yunpan.cn/cH7dXVnCPRqKs 访问密码 f11e
> norm.test <-function(x, breaks = 20, alpha = 0.05, plot = TRUE){
+ if(plot == TRUE){
+ #设置图形界面(多图合为一张图)
+ opar <- par(no.readonly = TRUE)
+ layout(matrix(c(1,1,2,3),2,2,byrow =TRUE), width = c(2,2),
+ heights = c(2,2))
+ #绘制直方图
+ hist(x, freq = FALSE,breaks = seq(min(x), max(x), length = breaks), main = 'x的直方图',ylab = '核密度值')
+ #添加核密度图
+ lines(density(x), col = 'red', lty = 1,lwd = 2)
+ #添加正态分布图
+ x <- x[order(x)]
+ lines(x, dnorm(x, mean(x), sd(x)), col ='blue', lty = 2, lwd = 2.5)
+ #添加图例
+ legend('topright',legend = c('核密度曲线','正态分布曲线'), col =c('red','blue'), lty = c(1,2), lwd = c(2,2.5), bty = 'n')
+ #绘制Q-Q图
+ qqnorm(x, xlab = '实际分布', ylab = '正态分布', main = 'x的Q-Q图', col = 'blue')
+ qqline(x)
+ #绘制P-P图
+ P <- pnorm(x, mean(x), sd(x))
+ cdf <- 0
+ for(i in 1:length(x)){cdf[i] <- sum(x<= x[i])/length(x)}
+ plot(cdf, P, xlab = '实际分布', ylab = '正态分布', main = 'x的P-P图', xlim = c(0,1), ylim = c(0,1), col ='blue')
+ abline(a = 0, b = 1)
+ par(opar)
+ }
+ #定量的shapiro检验
+ if (length(x) <= 5000) {
+ shapiro <- shapiro.test(x)
+ if(shapiro$p.value > alpha)
+ print(paste('定量结果为:', 'x服从正态分布,', 'P值=',round(shapiro$p.value,5), '> 0.05'))
+ else
+ print(paste('定量结果为:', 'x不服从正态分布,', 'P值=',round(shapiro$p.value,5), '<= 0.05'))
+ shapiro
+ }
+
+ else {
+ ks <- ks.test(x,'pnorm')
+ if(ks$p.value > alpha)
+ print(paste('定量结果为:', 'x服从正态分布,', 'P值=',round(ks$p.value,5), '> 0.05'))
+ else
+ print(paste('定量结果为:', 'x不服从正态分布,', 'P值=',round(ks$p.value,5), '<= 0.05'))
+ ks
+ }
+ }
>
>norm.test(fit$residuals)
[1] "定量结果为: x服从正态分布, P值 = 0.80937 > 0.05"
Shapiro-Wilk normality test
data: x
W = 0.9859, p-value= 0.8094
通过定性与定量的结果显示,模型的误差项满足正态性的假设。如果误差项不满足正态性检验,那么可以考虑对因变量采取Box-Cox转换(由于误差项是随机变量,因变量也是随机变量,如果误差项不满足正态性假设,也就意味着因变量也不满足正态性假设)。
关于Box-Cox转换可以使用car包中的powerTransform()函数。常见的转换形式可见如下表格:
> library(car)
>powerTransform(my.data$Murder)
Estimatedtransformation parameters
my.data$Murder
0.605542
从上图发现,需要变换的参数估计值为0.6,比较接近常见变换中的0.5,所以可以考虑将因变量Y变换为Y的开根号。但这里没有不建议这样操作,因为模型中的误差项已经服从正态分布了。
2、独立性假设
对于截面数据,检验个体间是否相互独立,一般通过收集到的数据本身进行验证,无法直接定量得出。例如不同用户的购买习惯、网页浏览情况等。在本例中可以认为美国各洲之间的谋杀率是相互独立的。对于时间序列数据,检验观察间是否相互独立,可以考虑使用杜宾-瓦特森检验(D-W检验)。该检验可以使用car包中的durbinWatsonTest函数实现。为了使用该函数,我们不妨也使用一下该函数,检验观测检的独立性:
> library(car)
>durbinWatsonTest(fit)
lag Autocorrelation D-W Statistic p-value
1 0.02852993 1.865058 0.652
Alternative hypothesis: rho != 0
检验结果显示,P值大于0.05,接受独立的原假设,即序列间不存在自相关性。
3、线性关系
可以绘制因变量与各个自变量的散点图,确定两者之间是否存在明显的线性关系。如果不存在线性关系,可以考虑变量变换(如对数变换、指数变换、多项式变换等),实现因变量与自变量的线性关系。
下面对因变量和自变量分别绘制散点图,以显示变量之间是否存在线性关系:
#谋杀率与人口数的散点图
opar <-par(no.readonly = TRUE)
par(mfrow =c(1,2))
plot(my.data$Population,my.data$Murder, xlab = 'Population', ylab = 'Murder')
abline(lm(my.data$Murder~my.data$Population),col = 'red')
text(15000,4,paste('相关系数为:',round(cor(my.data$Population,my.data$Murder),2)), col = 'blue')
#谋杀率与收入的散点图
plot(my.data$Income,my.data$Murder, xlab = 'Income', ylab = 'Murder')
abline(lm(my.data$Murder~my.data$Income),col = 'red')
text(5500,3,paste('相关系数为:',round(cor(my.data$Income, my.data$Murder),2)), col = 'blue')
#谋杀率与文盲率的散点图
plot(my.data$Illiteracy,my.data$Murder, xlab = 'Illiteracy', ylab = 'Murder')
abline(lm(my.data$Murder~my.data$Illiteracy),col = 'red')
text(2,4,paste('相关系数为:', round(cor(my.data$Illiteracy,my.data$Murder),2)), col = 'blue')
#谋杀率与寿命的散点图
plot(my.data[,'LifeExp'], my.data$Murder, xlab = 'Life Exp', ylab = 'Murder')
abline(lm(my.data$Murder~my.data[,'LifeExp']), col = 'red')
text(69,4,paste('相关系数为:', round(cor(my.data[,'Life Exp'],my.data$Murder),2)), col = 'blue')
#谋杀率与高中毕业率的散点图
plot(my.data[,'HSGrad'], my.data$Murder, xlab = 'HS Grad', ylab = 'Murder')
abline(lm(my.data$Murder~my.data[,'HSGrad']), col = 'red')
text(43,4,paste('相关系数为:', round(cor(my.data[,'HS Grad'],my.data$Murder),2)), col = 'blue')
plot(fit,which = 1)
par(opar)
从结果中可以得知只有各洲的文盲率、寿命与谋杀率存在较高的线性相关性。并且文盲率越高,谋杀率越高;老龄化越严重谋杀率越低。其他变量与谋杀率的相关性就显得不明显了。在“残差拟合值”散点图中明显存在一条非线性的曲线,说明某些变量与因变量之间不存在线性关系。
关于因变量与自变量的线性性假设,还可以通过成分残差图来判断各个自变量与因变量之间是否存在线性相关。该图的实现可运用car包的crPlots()函数。
> library(car)
> crPlots(fit)
可见该函数返回的线性相关性检验可视化图与上图中的散点图结论基本一致。
4、同方差性
如果模型的残差项不满足方差齐性的话,最小二乘估计将产生严重的错误,如参数估计量的方差不具有最小方差性,那么估计与预测的精度降低。
对于模型误差项方差齐性的检验:
方法一、可以使用扩展包lmtest中的bptest()函数。
> library(lmtest)
> bptest(fit)
studentized Breusch-Pagan test
data: fit
BP = 4.32, df = 5, p-value = 0.5043
方法二、或者利用car包中的ncv.test()函数
> library(car)
> ncvTest(fit)
Non-constantVariance Score Test
Variance formula: ~fitted.values
Chisquare =0.3819702 Df = 1 p = 0.5365507
> plot(x=fitted(fit), y=sqrt(abs(rstandard(fit))), xlab="预测值", ylab="学生化残差平方根")
> abline(h=0.75,col="blue")
不论从定性(位置尺度图中的散点随机分布在水平线0.75附近)和定量(P值均大于0.05)的角度,都可以说明模型的误差项符合方差齐性的假设。如果误差项不满足方差齐性的假设,也可以考虑Box-Cox变换,使模型的误差项满足方差齐性。
二、线性回归模型诊断
自变量之间如果有较强的相关关系,就很难求得较为理想的回归方程;若个别观测点与多数观测点偏离很远或因过失误差(如抄写或输入错误所致),它们也会对回归方程的质量产生极坏的影响。对这两面的问题进行监测和分析的方法,称为回归诊断。前者属于共线性诊断问题;后者属于异常点诊断问题。
1、共线性诊断(过拟合overfitting)
多重共线性是指线性回归模型中的解释变量之间由于存在精确相关关系或高度相关关系而使模型估计失真或难以估计准确。
方法一、通过方差膨胀因子(VIF)检验模型中的自变量间是否存在多重共线性。car包中的vif()函数检验
> library(car)
> vif(fit)
Population Income Illiteracy `Life Exp` `HS Grad`
1.154183 1.860073 2.006550 1.711095 2.675924
一般方差膨胀因子大于4就可能存在多重共线性问题。从上可知,没有一个变量的方差膨胀因子大于4,可以认为变量间不存在多重共线性。
方法二、还可以使用R自带的kappa()函数检验模型中变量的多重共线性。
>kappa(cor(my.data[, c("Population", "Income","Illiteracy", "Life Exp", "HS Grad")]))
[1] 8.75853
一般k<100时,则认为多重共线性可能性很小,100<= k <= 1000时,认为存在中等程度或较强的多重共线性,而k>1000时,认为存在严重的多重共线性。从结果中也说明这5个变量间不存在多重共线性。
2、异常点诊断
有关异常点诊断,《统计建模与R语言》中提到了帽子矩阵对角元素检验法、DFFITS准则、Cook统计量和COVRATIO准则。
帽子矩阵对角元素检验法
如果帽子矩阵对角元素满足如下条件,则认为第i组样本影响较大,可以结合其他准则,考虑是否将其剔除。
R中hatvalues()函数可以直接求得帽子矩阵的对角元素。
DFFITS准则
在满足以上条件时,可以认为第i个样本影响比较大,需要引起注意。R中dffits()函数可以计算得到D统计量。
Cook统计量
该统计量的计算可以使用cooks.distance()函数求得。一般来说,Cook统计量越大,说明该点越可能为异常点。但该方法的缺点是无法界定Cook统计量多大才算大,这需要视具体情况而定。
COVRATIO准则
有关COVRATIO值的计算可以直接使用covratio()函数得到。判定原则是:COVRATIO值离1越远,则认为样本对模型的的影响越大。
三、到此,基本完成了本文的两个任务,即模型的假设检验和模型的诊断,中间使用到了很多的函数来实现模型的检验。
1、R中提供了一个非常便捷的函数可以直接进行模型的假设检验,该函数是gvlma包中的gvlma函数。
> library(gvlma)
> gvlma(fit)
Call:
lm(formula = Murder~ ., data = my.data)
Coefficients:
(Intercept) Population Income Illiteracy `Life Exp`
1.186e+02 2.264e-04 -1.186e-05 2.604e+00 -1.686e+00
`HS Grad`
8.217e-02
ASSESSMENT OF THELINEAR MODEL ASSUMPTIONS
USING THE GLOBALTEST ON 4 DEGREES-OF-FREEDOM:
Level ofSignificance = 0.05
Call:
gvlma(x = fit)
Value p-value Decision
GlobalStat 2.31584 0.6779 Assumptions acceptable.
Skewness 0.05779 0.8100 Assumptions acceptable.
Kurtosis 1.02584 0.3111 Assumptions acceptable.
Link Function 0.58648 0.4438 Assumptions acceptable.
Heteroscedasticity0.64573 0.4216 Assumptions acceptable.
从上图中的红框内容显示,数据满足OLS(最小二乘法)回归模型的所有统计假设。如果“全局统计量”被拒绝,即认为模型不满足统计假设时,可以回到前面的检验过程进行一一验证并修正。
2、最后再讲解一下多元线性回归模型中逐步回归的过程,该过程分向前回归、向后回归和向前向后回归。
向前回归指原始模型不包含任何自变量,在该回归过程中一一向模型添加满足条件的自变量。
向后回归指原始模型包含所有自变量,在该过程中一一删除某些不满足条件的自变量。
向前向后回归则是同时考虑向前回归和向后回归,使模型在选择变量时有出有进。
R中step()函数就是用于实现多元线性模型的逐步回归过程,指定step()函数中direction参数,可以实现向前、向后和向前向后逐步回归。
> fit.new <-step(fit, direction="both")
Start: AIC=64.07
Murder ~ Population+ Income + Illiteracy + `Life Exp` + `HS Grad`
Df Sum of Sq RSS AIC
- Income 1 0.001 141.66 62.069
- `HS Grad` 1 8.066 149.72 64.838
- Population 1 43.358 185.01 75.421
- Illiteracy 1 61.517 203.17 80.102
- `Life Exp` 1 146.741 288.40 97.616
Step: AIC=62.07
Murder ~ Population+ Illiteracy + `Life Exp` + `HS Grad`
Df Sum of Sq RSS AIC
- `HS Grad` 1 10.837 152.49 63.755
+ Income 1 0.001 141.66 64.069
- Population 1 49.198 190.86 74.975
- Illiteracy 1 62.070 203.73 78.238
- `Life Exp` 1 147.187 288.85 95.693
>summary(fit.new)
Call:
lm(formula = Murder~ Population + Illiteracy + `Life Exp` +
`HS Grad`, data = my.data)
Residuals:
Min 1Q Median 3Q Max
-3.687 -1.132 0.052 1.357 3.323
Coefficients:
Estimate Std. Error t valuePr(>|t|)
(Intercept) 1.185e+02 1.717e+01 6.904 1.42e-08 ***
Population 2.259e-04 5.715e-05 3.953 0.00027 ***
Illiteracy 2.605e+00 5.867e-01 4.440 5.77e-05 ***
`Life Exp` -1.686e+00 2.466e-01 -6.838 1.77e-08 ***
`HS Grad` 8.161e-02 4.399e-02 1.855 0.07010 .
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’1
Residual standarderror: 1.774 on 45 degrees of freedom
MultipleR-squared: 0.7879, Adjusted R-squared: 0.769
F-statistic: 41.78on 4 and 45 DF, p-value:1.323e-14
> gvlma(fit.new)
Call:
lm(formula = Murder~ Population + Illiteracy + `Life Exp` + `HS Grad`, data = my.data)
Coefficients:
(Intercept) Population Illiteracy `Life Exp` `HS Grad`
1.185e+02 2.259e-04 2.605e+00 -1.686e+00 8.161e-02
ASSESSMENT OF THELINEAR MODEL ASSUMPTIONS
USING THE GLOBALTEST ON 4 DEGREES-OF-FREEDOM:
Level ofSignificance = 0.05
Call:
gvlma(x = fit.new)
Value p-value Decision
GlobalStat 2.29300 0.6820 Assumptions acceptable.
Skewness 0.05595 0.8130 Assumptions acceptable.
Kurtosis 1.03265 0.3095 Assumptions acceptable.
Link Function 0.56261 0.4532 Assumptions acceptable.
Heteroscedasticity0.64178 0.4231 Assumptions acceptable.
可见新模型在满足OLS假设条件前提下,模型的系数也通过了显著性检验,模型有进一步的提升。