一、多重共线性及其危害
我有一组自变量：
它们满足下列关系：
那么我们称这四个变量间存在多重共线性。
这就意味着，一个变量可以被另外几个变量来解释，这就会带来两个后果
1、尽管系数估计的无偏性没有收到影响，但是不幸的是，有效性变差了，也就是说估计的随机误差的方差不再是最小的，t值有可能变小，甚至相反，影响显著性判断。
2、随着变量X的增多，F检验值会增大，但是系数β会发生改变。
那我们该如何识别多重共线性呢？
二、VIF法和相关系数法
（一）相关系数法
由定义可知，若存在多重共线性，那么两个变量间相关系数会很大（一般我们都采用0.5标准，若大于0.5，则认为存在多重共线性），所以有可能出现多重共线性，我们可以通过计算相关系数实现。
R语言代码如下：
#导入数据library(readxl)travel <- read_excel("D:/search/homework/DataScience/workdata/travel.xlsx")#选取数据的数值型数据列travels<-travel[,4:12]#计算相关系数，方法选择pearsoncor(travels, method="pearson")#画出相关性矩阵图，标题：相关性矩阵图scatterplotMatrix(travels,spread = F,lty.smooth=2,main='相关性矩阵图')
（二）VIF法
VIF（方差膨胀因子）衡量多重共线性的方法，每个变量都有一个VIF，若单变量VIF超过10，则一定出现多重共线性，若大多数变量VIF在[1,2]之间，少数略超过2，则勉强接受没有多重共线性，若最大的VIF值不超过2，则没有多重共线性。R语言代码如下：
#多元回归（算VIF之前要先回归）GDP<-lm(lngdp~lntr+n+d5A+dsea,data=travel)coef(GDP)summary(GDP)#计算VIFlibrary(car)vif(GDP)
三、多重共线性解决
（一）经济学可以接受的方法
1、若只关心核心变量和F统计量，且核心变量与F统计量显著，则不需要解决多重共线性。
2、加样本
怎么在不减少变量下消除多重共线性？
（二）砍变量法
（1）最优子集法——一股脑全扔进去
①制造一个空集M0和P个变量
②每次挑K个放进去。
③挑出R square最大的几个模型
④交叉验证，优中选优，选出来BIC最小的几个模型。
缺点：计算量大
注意：③④两步在R语言是一块实现的
（2）向前回归——一个个加
①制造一个空集M0和P个变量。
②每次挑1个放进去。
③挑出R square最大的几个模型。
④交叉验证，优中选优，选出来BIC最小的几个模型。
（3）向后回归——一个个减
①制造一个空集M0和P个变量。
②每次挑1个拿走。
③挑出R square最大的几个模型。
④交叉验证，优中选优，选出来BIC最小的几个模型。
#最优子集法#导入数据shandong_travel <- read_excel("D:/search/homework/DataScience/workdata/shandong travel.xlsx")#选取数据的数值型数据列travels<-shandong_travel[,4:9]#引入leaps包library(leaps)#最优子集法回归subset.travels<-regsubsets(lngdp~.,travels)subset.travels<-regsubsets(lngdp~.,travels,nvmax = 5)full.summary<-summary(subset.travels)full.summary#显示有多少项目names(full.summary)#显示五个最优的R squarefull.summary $adjr2#显示五个最优的rssfull.summary $rss#准备作图#建一个1*2的图画本par(mfrow=c(1,2))#哪个模型的R square最大which.max(full.summary $adjr2)#哪个模型的BIC最小which.min(full.summary $bic)#哪个模型的RSS最小which.min(full.summary $rss)#画R square图plot(full.summary $adjr2,xlab = "number of variables",ylab = "adjr2",type = "b")#画BIC图plot(full.summary $bic,xlab = "number of variables",ylab = "bic",type = "b")#画RSS图plot(full.summary $rss,xlab = "number of variables",ylab = "rss",type = "b")#提取最优模型的系数和截距coef(subset.travels,4)##逐步回归法#向前回归subset.travels2<-regsubsets(lngdp~.,travels,method = "forward")summary(subset.travels2)#向后回归subset.travels2<-regsubsets(lngdp~.,travels,method = "backward")summary(subset.travels2)
事实上，两种逐步回归法都有致命的缺陷——即使完成了筛选，也不一定把多重共线性赶走。
（3）lasso回归——你太小就得被挤压成0
众所周知，回归是用对残差平方和最小求偏导来求系数：即
现在,我们知道多重共线性会影响随机误差，我们知道这样算出来的系数偏差很小，根据：
我们知道要给它套上一个惩罚函数使它偏差增大，方差变小：
用图像可以表示为：
这说明，
（其中一个系数）被压缩了成零，被系数的变量剔除了。
R语言代码如下：
##lasso惩罚#导入数据library(readxl)shandong_travel <- read_excel("D:/search/homework/DataScience/workdata/shandong travel.xlsx")View(shandong_travel)#导入lars包library(lars)#定义数据data=shandong_travel#建立矩阵x=as.matrix(data[, 5:10]) y=as.matrix(data[,4])la=lars(x=data[, 5:10],y=data[,4])#lasso回归lar1<-lars(x,y,type = "lasso")lar1###lasso结果#Call:#lars(x = x, y = y, type = "lasso")#R-squared: 0.923 #Sequence of LASSO moves:#lninvest lnemploy dsea d5A n LNT#Var 2 1 4 5 6 3#Step 1 2 3 4 5 6#画lasso图plot(lar1)#总结summary(lar1)LARS/LASSOCall: lars(x = x, y = y, type = "lasso")#DfRss Cp#0 1 28.2877 932.9938#1 2 3.8257 56.4056#2 3 2.4494 8.9723#3 4 2.2843 5.0447#4 5 2.2749 6.7072#5 6 2.2102 6.3836#6 7 2.1717 7.0000#哪个CP值最小（CP值最小最好）lar1$Cp[which.min(lar1$Cp)]#显示所有的β值lar1$beta#lnemploy lninvest LNT dsead5A#0 0.00000000 0.0000000 0.00000000 0.00000000 0.000000000#1 0.00000000 0.7455201 0.00000000 0.00000000 0.000000000#2 0.10307710 0.8434076 0.00000000 0.00000000 0.000000000#3 0.09166324 0.8963167 0.00000000 -0.05832763 0.000000000#4 0.09113164 0.9005081 0.00000000 -0.06210445 -0.003884843#5 0.09512079 0.9335822 0.00000000 -0.07811536 -0.020465424#6 0.09446922 0.9983330 -0.01251348 -0.09637642 -0.028478241##挑出最好的系数(s是Df+1,就是开头是0那一列)coef<-coef.lars(lar1,mode="step",s=4)##把系数为0的全弄出去coef[coef!=0]#加入截距#s的含义和第4部分求取coef中的s相同，代表第几次迭代对应的模型的截距值。且data.frame中自变量的数量和数据框中进行lasso拟合的自变量数目相同，都要写上。predict(lar1,data.frame(SHDI=0,MIDU=0,LSI=0,CONTAF=0,MPS=0,PD=0),s=4)
