R小练习，哑变量处理，多重共线性检测

一、哑变量

   做回归模型的时候，要是是连续的数值，是很方便的直接回归的。但如果有些变量是不连续的，比如男/女，但是我们又想把他们放到模型里，这时候可以采用哑变量来处理。增加一个变量nan ,是男的就为1，不是就为0. 这里不能增加两个，如果给女也增加一个，会造成严重的多重共线性。下面，用iris数据集练习一遍

names(iris) 
unique(iris$Species)
nrow(iris)

iris$v1 <- rep(0,150)
iris$v2 <- rep(0,150)
iris$v1[iris$Species=="setosa"] <- 1   　　＃生成哑变量表示是否是ｓｅｔｏｓａ品种
iris$v2[iris$Species=="versicolor"] <- 1　＃生成哑变量表示是否是ｖｅｒｓｉｃｏｌｏｒ品种
＃两个都为０表示是第三品种种。
＃随意画画，挑选两个比较有线性关系的变量
plot(iris$Sepal.Length[iris$v1==1],iris$Sepal.Width[iris$v1==1])
plot(iris$Sepal.Length[iris$v2==1],iris$Sepal.Width[iris$v2==1])
plot(iris$Petal.Length[iris$v2==1],iris$Petal.Width[iris$v2==1])
plot(iris$Petal.Length[iris$v1==1],iris$Petal.Width[iris$v1==1])
plot(iris$Petal.Length[iris$v1==1],iris$Sepal.Width[iris$v1==1])
plot(iris$Petal.Length[iris$v1==0],iris$Sepal.Width[iris$v1==0])

#选择花瓣长度，和花萼长度，同时引入哑变量，既影响斜率，也影响截距。
model <- lm(Petal.Length ~ 1 + Sepal.Length + v1 + v2 + v1:Sepal.Length + v2:Sepal.Length,
data=iris)
summary(model)

Call:
lm(formula = Petal.Length ~ 1 + Sepal.Length + v1 + v2 + v1:Sepal.Length + 
    v2:Sepal.Length, data = iris)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.68611 -0.13442 -0.00856  0.15966  0.79607 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.61047    0.38822   1.572    0.118    
Sepal.Length     0.75008    0.05866  12.787   <2e-16 ***
v1               0.19258    0.65781   0.293    0.770    
v2              -0.42535    0.57974  -0.734    0.464    
Sepal.Length:v1 -0.61845    0.12100  -5.111    1e-06 ***
Sepal.Length:v2 -0.06361    0.09308  -0.683    0.495    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2611 on 144 degrees of freedom
Multiple R-squared:  0.9789,    Adjusted R-squared:  0.9781 
F-statistic:  1333 on 5 and 144 DF,  p-value: < 2.2e-16

#可以看到对截距没啥影响，
#逐步回归，去掉没用的变量
> step(model)
Start:  AIC=-396.96
Petal.Length ~ 1 + Sepal.Length + v1 + v2 + v1:Sepal.Length + 
    v2:Sepal.Length

                  Df Sum of Sq     RSS     AIC
- Sepal.Length:v2  1   0.03184  9.8497 -398.48
<none>                          9.8179 -396.96
- Sepal.Length:v1  1   1.78126 11.5991 -373.96

Step:  AIC=-398.48
Petal.Length ~ Sepal.Length + v1 + v2 + Sepal.Length:v1

                  Df Sum of Sq     RSS     AIC
<none>                          9.8497 -398.48
- Sepal.Length:v1  1    1.8074 11.6571 -375.21
- v2               1   12.6848 22.5345 -276.34

Call:
lm(formula = Petal.Length ~ Sepal.Length + v1 + v2 + Sepal.Length:v1, 
    data = iris)

Coefficients:
    (Intercept)     Sepal.Length               v1               v2  
        0.77692          0.72481          0.02613         -0.81942  
Sepal.Length:v1  
       -0.59318 


#去掉- Sepal.Length:v2
> model2 <- lm(formula = Petal.Length ~ Sepal.Length + v1 + v2 + Sepal.Length:v1, 
+     data = iris)
> summary(model2)

Call:
lm(formula = Petal.Length ~ Sepal.Length + v1 + v2 + Sepal.Length:v1, 
    data = iris)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.67814 -0.13771 -0.00463  0.16512  0.79361 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.77692    0.30176   2.575    0.011 *  
Sepal.Length     0.72481    0.04546  15.944  < 2e-16 ***
v1               0.02613    0.60994   0.043    0.966    
v2              -0.81942    0.05996 -13.665  < 2e-16 ***
Sepal.Length:v1 -0.59318    0.11500  -5.158 8.05e-07 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2606 on 145 degrees of freedom
Multiple R-squared:  0.9788,    Adjusted R-squared:  0.9782 
F-statistic:  1673 on 4 and 145 DF,  p-value: < 2.2e-16

#去掉v1 去掉之后效果很好了
> model3 <- lm(formula = Petal.Length ~ Sepal.Length + v2 + Sepal.Length:v1,data=iris) 
> summary(model3)

Call:
lm(formula = Petal.Length ~ Sepal.Length + v2 + Sepal.Length:v1, 
    data = iris)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.67794 -0.13770 -0.00431  0.16602  0.79367 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.78332    0.26134   2.997   0.0032 ** 
Sepal.Length     0.72386    0.03947  18.341   <2e-16 ***
v2              -0.82014    0.05737 -14.295   <2e-16 ***
Sepal.Length:v1 -0.58830    0.01581 -37.208   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2597 on 146 degrees of freedom
Multiple R-squared:  0.9788,    Adjusted R-squared:  0.9784 
F-statistic:  2246 on 3 and 146 DF,  p-value: < 2.2e-16

#抽取20个数据 把预测结果和实际值比较
> seed <- sample(1:150,20,replace=F)
> myiris <- iris[seed,]
> pre <- predict(model3,newdata=myiris,interval="prediction")
> cbind(pre,iris[seed,3])
         fit       lwr      upr    
127 5.271238 4.7520755 5.790401 4.8
13  1.433980 0.9154302 1.952530 1.4
12  1.433980 0.9154302 1.952530 1.6
48  1.406869 0.8873564 1.926382 1.4
40  1.474647 0.9559872 1.993306 1.5
25  1.433980 0.9154302 1.952530 1.9
92  4.378713 3.8601119 4.897314 4.6
137 5.343624 4.8248204 5.862428 5.6
83  4.161555 3.6430037 4.680107 3.9
93  4.161555 3.6430037 4.680107 4.0
9   1.379758 0.8584587 1.901058 1.4
114 4.909309 4.3866058 5.432013 5.0
103 5.922711 5.4025604 6.442861 5.9
57  4.523484 4.0042644 5.042704 4.7
46  1.433980 0.9154302 1.952530 1.4
75  4.595870 4.0761653 5.115575 4.3
87  4.813028 4.2911708 5.334884 4.7
64  4.378713 3.8601119 4.897314 4.7
86  4.306327 3.7878598 4.824794 4.5
66  4.813028 4.2911708 5.334884 4.4

二、多重共线性诊断

    多重共线性会导致对矩阵求逆的时候结果不稳定。将自变量矩阵中心化和标准化后，右乘自己转置向量。对这个矩阵求特征根。如果特征根接近于0，很可能出现多重共线性。可以利用kappa函数，求最大特征根除以最小特征根，如果这个值小于100，可以认为没有多重共线性，如果大于1000可以认为有严重的多重共线性。在R语言里。car包中还提供了vif函数，可以直接用给model，用方差膨胀因子来判断是否有多重共线性。使用方法：library(car); vif(model).

   以longley数据集为例，使用kappa来判断是否有多重共线性。

> longley <- longley[-6]       #首先去掉年份 这个变量不要
#直接对所有的变量做回归，效果不好
> model <- lm(GNP.deflator ~ .,data=longley)
> summary(model)

Call:
lm(formula = GNP.deflator ~ ., data = longley)

Residuals:
     Min       1Q   Median       3Q      Max 
-2.07502 -0.43246  0.08478  0.50481  1.55564 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)   
(Intercept)  225.800117  81.873096   2.758  0.02020 * 
GNP            0.221305   0.060903   3.634  0.00458 **
Unemployed     0.022501   0.008190   2.747  0.02057 * 
Armed.Forces   0.004825   0.007800   0.619  0.55000   
Population    -1.707504   0.644747  -2.648  0.02438 * 
Employed      -0.273425   0.746137  -0.366  0.72166   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.148 on 10 degrees of freedom
Multiple R-squared:  0.9925,    Adjusted R-squared:  0.9887 
F-statistic: 263.2 on 5 and 10 DF,  p-value: 2.836e-10
#求t(x)*x矩阵
> xx <- cor(longley[-1])
#计算kappa值
> kappa(xx,exact=T)
[1] 2300.046
#我们也可以自己计算
#> z <- eigen(xx)$values
#> max(z)/min(z)
#[1] 2300.046
#把特征根都拿出来看看。 最小的是最后一个
> eigen(xx)
$values
[1] 3.54945385 1.18554368 0.25115747 0.01230179 0.00154321

$vectors
           [,1]        [,2]       [,3]        [,4]         [,5]
[1,] -0.5278599  0.03392182 -0.1786603 -0.22631424  0.798170175
[2,] -0.3519851 -0.61503723  0.6651187  0.23531386  0.008957406
[3,] -0.2354739  0.77911377  0.5766000  0.05603713 -0.043886189
[4,] -0.5272243 -0.06530038 -0.1071890 -0.63539332 -0.550051136
[5,] -0.5138648  0.09641636 -0.4263104  0.69752736 -0.241582049

#最小特征根 对应最后一列特征向量
#0.7981*GNP+0.008*UnEmployed-0.043*Armed.Force-0.55*population-0.241*emploeyd ≈ 0
#这个式子直可以验算
#> a <- eigen(xx)$vectors
#> b <- a[,5]
#> is.vector(b)
#> data <- scale(longley[-1])
#> data%*%b   算出来，这列的结果约等于0
#所以 GNP和人口还有工作人数存在线性相关。 做到这里忘记了GNP国民生产总值忘记剔除了，不过剔除这个变
#量还是会发现工作人数、失业人数还有总人口是存在严重多重共线性的。
#所以对模型修正，去掉GNP和 人口中的一个变量，重新尝试回归
> model <- update(model,.~. - GNP - Unemployed,data=longley)
> summary(model)
Call:
lm(formula = GNP.deflator ~ Armed.Forces + Employed + Population, 
    data = longley)

Residuals:
   Min     1Q Median     3Q    Max 
-2.926 -1.002  0.078  0.974  3.253 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -81.184312   9.549822  -8.501 2.01e-06 ***
Armed.Forces   0.014181   0.008047   1.762  0.10347    
Employed       0.819325   0.532912   1.537  0.15012    
Population     1.070081   0.256941   4.165  0.00131 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.839 on 12 degrees of freedom
Multiple R-squared:  0.9768,    Adjusted R-squared:  0.971 
F-statistic: 168.2 on 3 and 12 DF,  p-value: 4.565e-10

#最终得到的模型
GDP = -82.184 + 0.014*军队数量 +0.8193*工作人口 +1.07*总人口。