teengamb数据集进行回归分析
回归分析
在 faraway 包中，包含一个 47 行 5 列的 teengamb 数据集（加载 faraway包后，可通过代码“head(teengamb)”查看数据的前 5 行，通过“?teengamb”查看每个变量的具体意义），该数据是研究关于青少年赌博情况的数据集。针对该数据集，请回答以下问题：
Sex:性别，0=男性，1=女性。
Status：基于父母职业的社会经济状况评分
Income：每周的收入，英镑
Verbal:正确定义的 12 各单词的口头评分
Gamle:每年赌博的开支，英镑。
（1）如果只考虑 sex、income、verbal 三个变量作为自变量，预测因变量 gamble
时，可以使用哪些回归模型进行预测？要求建立的回归模型数量不少于 3 个，
并对为什么要建立这样的回归模型进行解释；
先进行相关系数分析：
library(corrplot)
library(faraway)
library(ggcorrplot)
library(tidyr)
library(GGally)
data(teengamb)
head(teengamb)
teengamb<-teengamb
?teengamb
teen<-data.frame(teengamb$sex,teengamb$income,teengamb$gamble,teengamb$verbal)
voice_cor <- cor(teen)
corrplot.mixed(voice_cor,tl.col="black",tl.pos = "lt",
tl.cex = 2,number.cex = 1)
结果如下：
> head(teengamb)
sex status income verbal gamble
1 1 51 2.00 8 0.0
2 1 28 2.50 8 0.0
3 1 37 2.00 6 0.0
4 1 28 7.00 4 7.3
5 1 65 2.00 8 19.6
6 1 61 3.47 6 0.1
可发现，income 和 gamble 收入相关性达到 0.62，较强相关，gamble 与 sex 相关系数为-0.41，成一定相关性，说明与性别有关系。
再进行多元线性回归：
## 多元线型回归
lm1 <- lm(gamble~sex+income+verbal,data = teengamb)
summary(lm1)
结果如下：
> summary(lm1)
Call:
lm(formula = gamble ~ sex + income + verbal, data = teengamb)
Residuals:
Min 1Q Median 3Q Max
-50.639 -11.765 -1.594 9.305 93.867
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 24.1390 14.7686 1.634 0.1095
sex -22.9602 6.7706 -3.391 0.0015 **
income 4.8981 0.9551 5.128 6.64e-06 ***
verbal -2.7468 1.8253 -1.505 0.1397
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 22.43 on 43 degrees of freedom
Multiple R-squared: 0.5263, Adjusted R-squared: 0.4933
F-statistic: 15.93 on 3 and 43 DF, p-value: 4.148e-07
经多元线性回归，系数检验发现，verbal 检验的 p 值为 0.1397>0.05,不显著，故可考虑剔除 verbal 做多元线性回归。
考虑剔除verbal ：
#剔除verbal
lm2 <- lm(gamble~sex+income,data = teengamb)
summary(lm2)
library(broom)
## 可视化回归模型的图像
par(mfrow = c(2,2))
plot(lm2)
结果如下：
> summary(lm2)
Call:
lm(formula = gamble ~ sex + income, data = teengamb)
Residuals:
Min 1Q Median 3Q Max
-49.757 -11.649 0.844 8.659 100.243
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.041 6.394 0.632 0.53070
sex -21.634 6.809 -3.177 0.00272 **
income 5.172 0.951 5.438 2.24e-06 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 22.75 on 44 degrees of freedom
Multiple R-squared: 0.5014, Adjusted R-squared: 0.4787
F-statistic: 22.12 on 2 and 44 DF, p-value: 2.243e-07
可发现，参数的检验 sex,income 都较为显著，而 Adjusted R-squared=0.4787
可得到回归方程：
gamble = 4.041 − 21.634 ∗ sex + 5.172 ∗ income
再进行逐步线性回归：
Enblm <- lm(gamble~sex+income+verbal,data = teengamb)
summary(Enblm)
## Coefficients: (1 not defined because of singularities)
## 因为奇异性问题，有一个变量没有计算系数
## 判断模型的多重共线性问题
kappa(Enblm,exact=TRUE) #exact=TRUE表示精确计算条件数；
alias(Enblm)
## 逐步回归
Enbstep <- step(Enblm,direction = "both")
summary(Enbstep)
## 判断模型的多重共线性问题
kappa(Enbstep,exact=TRUE)
vif(Enbstep)
结果如下：
> Enbstep <- step(Enblm,direction = "both")
Start: AIC=296.21
gamble ~ sex + income + verbal
Df Sum of Sq RSS AIC
<none> 21642 296.21
- verbal 1 1139.8 22781 296.63
- sex 1 5787.9 27429 305.35
- income 1 13236.1 34878 316.64
> summary(Enbstep)
Call:
lm(formula = gamble ~ sex + income + verbal, data = teengamb)
Residuals:
Min 1Q Median 3Q Max
-50.639 -11.765 -1.594 9.305 93.867
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 24.1390 14.7686 1.634 0.1095
sex -22.9602 6.7706 -3.391 0.0015 **
income 4.8981 0.9551 5.128 6.64e-06 ***
verbal -2.7468 1.8253 -1.505 0.1397
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 22.43 on 43 degrees of freedom
Multiple R-squared: 0.5263, Adjusted R-squared: 0.4933
F-statistic: 15.93 on 3 and 43 DF, p-value: 4.148e-07
> kappa(Enbstep,exact=TRUE)
[1] 39.20124
> vif(Enbstep)
sex income verbal
1.030968 1.051585 1.049578
可发现，不存在多重共线性，故结果将与多元线性回归一致。
（2）使用所有的变量预测因变量 gamble，并且使用 step()函数对模型进行逐步回归，分析逐步回归后的结果；
Enblm <- lm(gamble~sex+income+verbal+status,data = teengamb)
summary(Enblm)
## Coefficients: (1 not defined because of singularities)
## 因为奇异性问题，有一个变量没有计算系数
## 判断模型的多重共线性问题
kappa(Enblm,exact=TRUE) #exact=TRUE表示精确计算条件数；
alias(Enblm)
## 逐步回归
Enbstep <- step(Enblm,direction = "both")
summary(Enbstep)
## 判断模型的多重共线性问题
kappa(Enbstep,exact=TRUE)
vif(Enbstep)
结果如下：
#原始状态，未剔除变量
> summary(Enblm)
Call:
lm(formula = gamble ~ sex + income + verbal + status, data = teengamb)
Residuals:
Min 1Q Median 3Q Max
-51.082 -11.320 -1.451 9.452 94.252
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 22.55565 17.19680 1.312 0.1968
sex -22.11833 8.21111 -2.694 0.0101 *
income 4.96198 1.02539 4.839 1.79e-05 ***
verbal -2.95949 2.17215 -1.362 0.1803
status 0.05223 0.28111 0.186 0.8535
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 22.69 on 42 degrees of freedom
Multiple R-squared: 0.5267, Adjusted R-squared: 0.4816
F-statistic: 11.69 on 4 and 42 DF, p-value: 1.815e-06
> kappa(Enblm,exact=TRUE) #exact=TRUE表示精确计算条件数；
[1] 263.8049
> alias(Enblm)
Model :
gamble ~ sex + income + verbal + status
#此时存在多重共线性，条件数为263，较大
#逐步回归后：
> Enbstep <- step(Enblm,direction = "both")
Start: AIC=298.18
gamble ~ sex + income + verbal + status
Df Sum of Sq RSS AIC
- status 1 17.8 21642 296.21
<none> 21624 298.18
- verbal 1 955.7 22580 298.21
- sex 1 3735.8 25360 303.67
- income 1 12056.2 33680 317.00
Step: AIC=296.21
gamble ~ sex + income + verbal
Df Sum of Sq RSS AIC
<none> 21642 296.21
- verbal 1 1139.8 22781 296.63
+ status 1 17.8 21624 298.18
- sex 1 5787.9 27429 305.35
- income 1 13236.1 34878 316.64
> summary(Enbstep)
Call:
lm(formula = gamble ~ sex + income + verbal, data = teengamb)
Residuals:
Min 1Q Median 3Q Max
-50.639 -11.765 -1.594 9.305 93.867
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 24.1390 14.7686 1.634 0.1095
sex -22.9602 6.7706 -3.391 0.0015 **
income 4.8981 0.9551 5.128 6.64e-06 ***
verbal -2.7468 1.8253 -1.505 0.1397
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 22.43 on 43 degrees of freedom
Multiple R-squared: 0.5263, Adjusted R-squared: 0.4933
F-statistic: 15.93 on 3 and 43 DF, p-value: 4.148e-07
#R方为0.4933，P值<0.05,模型检验通过。
> kappa(Enbstep,exact=TRUE)
[1] 39.20124
> vif(Enbstep)
sex income verbal
1.030968 1.051585 1.049578
逐步回归之后，回归模型的条件数变为 39.20124，此时剔除了 status 变量。
（3）如果以性别为因变量，能够根据其他的几个数据特征准确地预测出性别吗？如果可以，那么预测的准确率是多少？如果不可以，请说明为什么？
利用逻辑斯特回归预测：
library(caret)
library(Metrics)
library(dplyr)
voicelm <- glm(sex~.,data = teengamb,family = "binomial")#利用逻辑斯特回归预测
summary(voicelm)
label<-predict(voicelm,teengamb[,2:5],type = "response")
label <- as.factor(ifelse(label > 0.5,1,0))#将数据规范为0，1
table(teengamb$sex,label)
sprintf("逻辑回归模型的精度为：%f",accuracy(teengamb$sex,label))
结果如下：
> summary(voicelm)
Call:
glm(formula = sex ~ ., family = "binomial", data = teengamb)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.50499 -0.57882 -0.09388 0.59949 2.58612
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.63905 1.90352 1.912 0.0559 .
status -0.10108 0.04033 -2.507 0.0122 *
income 0.10653 0.18900 0.564 0.5730
verbal 0.13822 0.25711 0.538 0.5909
gamble -0.08651 0.04247 -2.037 0.0417 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 63.422 on 46 degrees of freedom
Residual deviance: 36.140 on 42 degrees of freedom
AIC: 46.14
Number of Fisher Scoring iterations: 7
> table(teengamb$sex,label)
label
0 1
0 23 5
1 4 15
> sprintf("逻辑回归模型的精度为：%f",accuracy(teengamb$sex,label))
[1] "逻辑回归模型的精度为：0.808511"
精度为80%，较低，可尝试使用深度学习方法和支持向量机等机器学习方法。详细可参加另一篇文章《对于teengamb数据集进行神经网络分类》