数学建模社区-数学中国
标题: 【高级数理统计R语言学习】2 多元线性回归 [打印本页]
作者: 1047521767 时间: 2021-10-29 11:44
标题: 【高级数理统计R语言学习】2 多元线性回归
【高级数理统计R语言学习】2 多元线性回归一、背景
`+ G8 e) Q' K- I数据集展示了X市外来人口的相关数据情况,包括出生年月、收入、初次来到X市的日期、迁离X市的日期和现在的朋友数量。现假设外来人口的年龄、在X市的居住时间和朋友数量影响他们的收入。试加以证明。
二、要求和代码
一、分析收入的影响因素' w3 t! n, _) x8 p
#11 @+ T! _: R- Z! P+ F# Q, q6 k
#展示数据集的结构
) r( [4 x( |2 v, ]; v! _# J+ [data2 <- read.csv(file="F:/hxpRlanguage/homework2.csv",header=TRUE,sep=",")( y9 B! ]. ~ r) ]5 X" C
str(data2) #显示的结果有一列是多余的,需要删除# O3 I- W0 ]! s) \% _
data2 <- data2[,1:9]
1 B1 {3 ]1 y; V/ ?; C2 hstr(data2) #删完之后的显示效果是正常的没有多余列( l6 K% g* H! Y
+ y0 b6 d" n8 n* t! _8 X2 @#2$ i- x8 Y4 v* q7 q9 y
#显示前10条数据记录
% v" I7 ~ r" N: |4 f3 i3 o; Xdata2[1:10,]
/ ?; Q" E/ b% Z$ x& g' |1 f" d4 h8 Y0 P- C+ y
#3" X) u5 Q _$ t* y& w' x+ D z
#将变量名重新命名为英文变量名
1 x& J( ~" e7 Ycnames <- c("number","birthyear","birthmonth","salary","inyear","inmonth","outyear","outmonth","friends") |# U* |1 M/ y5 b3 p5 \* r+ _
colnames(data2) <- cnames" U7 ~+ b6 e p- q. J
View(data2)8 G( j9 k& ]: {$ L+ }
7 Z; F0 [8 r) [/ L- k, A
#4
5 f. K' ]5 D8 j/ V7 D$ Y#查找数据集中居住时间小于等于0的异常记录,若存在,从数据集中删除这些异常记录" u) t$ L+ [9 A
x2 <- ((data2$outyear-data2$inyear)*12+(data2$outmonth-data2$inmonth))
: t2 L0 a# d: c* G9 L#View(x2) #①先算出居住时间
. ` }. Y& r( q: k) Ldata3 <- cbind(data2,x2)0 i/ V A* f- ^4 v0 _" T' X
#View(data3) #②使用cbind函数把x2和原数据拼成新的矩阵,方便之后删除异常数据列,并且是127条9 p/ D( r. U' I. n' z
list <- which(x2<=0)
/ a: `. ?1 o) D4 q% ^data3 <- data3[-list,]
7 ^) j) z* T- ~* dView(data3) #删除异常数据后是125条数据. v' ?6 S! n5 r# k2 k
" ~+ Q1 |$ s" F' D B5 b$ i( A
#5
! m2 `1 s" n) b9 }! L |#展示数据集中因变量与自变量的均值、最小值、中位数、最大值和标准差,要求保留2位小数。5 }* I4 W/ H9 l& l: R. \
library(lubridate)% p2 _) [8 D( v0 z- m: O4 E" r) J- g. z
date<-Sys.Date() #返回系统当前的时间8 O2 B/ w1 M& ?4 Y0 e9 t0 \
nowyear<-year(date) #提取年份& U; R; O+ ]/ g0 u' {0 b
nowmonth<-month(date) #提取月份
' z7 b' F5 M( R" V. B2 M0 X- q4 R" }1 t#View(date) #查看现在的日期, J, G+ J, Z) e% Z
#View(month(date)) #查看现在日期中的月份
# O) s+ o, ^8 o$ i: o6 ix1 <- array(1:nrow(data3),dim=c(nrow(data3),1))
/ @9 I: J/ f6 G8 H5 A( cfor(i in c(1:nrow(data3)) ){, F3 V s( b4 o; p+ d
if(nowmonth-data3[i,"birthmonth"]<0){
4 \% ]/ Y0 q: _+ j' |9 p x1[i,1] <- nowyear-data3[i,"birthyear"]-1! |! i7 V4 E" k
}else{
* Y. H1 R. N v( w6 [ x1[i,1] <- nowyear-data3[i,"birthyear"]
3 k6 d W3 b8 U" h7 I }" V9 t5 n6 z9 c( K4 d
} B4 `8 J! b O4 Q/ M/ e" S1 S0 b3 H( N
#View(x1) #算出年龄x1,并加入到数据表中
4 g+ G8 J1 {8 F1 h5 `data4 <- cbind(data3,x1)
. k4 Y% F0 h- J; @View(data4) #加入x1年龄变量的新表展示8 `) B2 ^, M: x# C+ ~8 L" |
x2 <- data4$x2+ V3 b- u' D! @3 M3 g% b
Mean.x2 <- round(mean(x2),2)' N# c# M- D4 I* U) N
Min.x2 <- round(min(x2),2)
" K8 W8 V9 [7 i# F) x0 mMax.x2 <- round(max(x2),2)- L! B0 g% P! C# V u3 N
Median.x2 <- round(median(x2),2)( q( L1 N0 f u" x( N! u) m) O) Y
Sd.x2 <- round(sd(x2),2)* }9 Q; m% V x- I; p
cbind(Mean.x2,Min.x2,Max.x2,Median.x2,Sd.x2) #x2居住时间的相关结果9 @9 ~1 V, d" A0 o o! R
Mean.x1 <- round(mean(x1),2)
7 e) C6 |# y1 zMin.x1 <- round(min(x1),2)% |3 D( K, {1 Q( ]/ p
Max.x1 <- round(max(x1),2)
5 n5 a6 j3 e( U6 GMedian.x1 <- round(median(x1),2)3 F `/ }$ C* r( B2 ]& @5 S E
Sd.x1 <- round(sd(x1),2)
- x4 c5 q9 J, |/ |cbind(Mean.x1,Min.x1,Max.x1,Median.x1,Sd.x1) #x1年龄的相关结果
4 ]" G/ k- ?: B, ?x3 <- data4$friends
$ Q7 d& j' W' A1 W( _8 ~Mean.x3 <- round(mean(x3),2)
1 P6 t7 C h- T! GMin.x3 <- round(min(x3),2)8 l6 b* [, r8 P8 H" ?- N
Max.x3 <- round(max(x3),2)
; E# Y& B* f: }8 ]/ uMedian.x3 <- round(median(x3),2)/ Z" @3 a: ^+ }. q$ {) f
Sd.x3 <- round(sd(x3),2)9 H) d) O o+ L! e9 U5 E
cbind(Mean.x3,Min.x3,Max.x3,Median.x3,Sd.x3) #x3朋友数量的相关结果
6 L- s t0 M$ m* A! R; vy <- data4$salary9 [, W. G h0 Q7 ^$ ~" J
Mean.y <- round(mean(y),2)3 H* O2 B+ ]- z0 a* `: A
Min.y <- round(min(y),2) N8 H6 H4 ~6 Z) h9 k# m
Max.y <- round(max(y),2)
! ~# n! n- W) k' U1 V/ X2 GMedian.y <- round(median(y),2); ]6 j0 |$ P1 R3 S5 K/ F! Q( b
Sd.y <- round(sd(y),2)
, Q5 h6 _( Z( U# vcbind(Mean.y,Min.y,Max.y,Median.y,Sd.y) #因变量y的相关结果8 c _8 d: `5 _% f( i( o2 w
+ G( x" S* y, D5 d8 _! L#6$ E% n4 a1 @) D( m3 b% i
#计算数据集中因变量和自变量的相关系数,要求保留2位小数。
% i3 i# j" l3 p( nround(cor(y,x1),2) #y和x1年龄! O9 m6 B5 y& ^& j
round(cor(y,x2),2) #y和x2居住时间
4 _$ ]0 g3 q2 l: K) c: r: \( E3 q# qround(cor(y,x3),2) #y和x3朋友数量
; a3 h# D% k5 z2 j0 _) E1 d' V' k% C x- A- I0 q) L5 A
#7; K5 _4 Z; {" T3 P
#分别绘制数据集中因变量与各个自变量的散点图! Y; p7 f% q3 H/ D
par(mfrow=c(1,3)) #布局,一行画3个图
0 r+ b' F; \" r5 yplot(x1,y,xlab="年龄x1",ylab="工资y")
1 R) A+ L' Y$ a4 V: G- E4 Uplot(x2,y,xlab="居住时间x2",ylab="工资y")
+ z* r7 C* q& V/ E; B6 o' O& @: Splot(x3,y,xlab="朋友数量x3",ylab="工资y")
2 i [5 Z% a2 e! `8 i+ m; u: b1 d
* ], ]8 b% i" }/ o#87 v$ U9 l4 s/ b( g7 I
#利用多元线性回归模型对数据集中因变量与自变量的关系进行拟合。! d& J2 e" F: |+ ?
lm.xy <- lm(y~x1+x2+x3)
2 i8 I" Z; r" ~; e% @; a- Alm.xy" g( N; B, ^9 v6 N! R9 _2 c
summary(lm.xy) #得到的结果是方程是显著的具有线性关系,但是每一个系数不都是显著的 C, E/ @) E. U, r8 H
0 ?* E. w+ @; W
#9; Y8 C$ o8 J( f& W! z F
#对#8中的多元线性回归模型进行诊断,确定异常值记录。
' e3 ^9 C, m, N' z7 Y- N4 dpar(mfrow = c(2,2)) #生成四种模型诊断的图形,2行2列! ]& D( \, v0 {, n: ]/ U9 _" e
#生成四种模型诊断的图形:①残差与真实值的关系图 ②qq图用来检测其残差是否是正态分布
, w6 u, p. h4 [/ R6 P d#③用来检查等方差假设的。在一开始我们的五大假设第二条便是,我们假设预测的模型里方差是一个定值。# C7 h* I% K, Z9 y' b0 v
#如果方差不是一个定值那么这个模型的可靠性也是大打折扣的。
/ y7 `3 A7 x* R+ ~) e/ M- U; ^( A#④Leverage就是杠杆的意思。这种图的意义在于检查数据分析项目中是否有特别极端的点。' |/ W2 l* ^8 B! D; [3 n
plot(lm)
( ^7 g5 P# ?% m: M, ~) Olibrary(carData)* C) C' I+ S- C5 [7 i: w2 w) P
library(car)3 [: ~' f' j+ o) j: a+ `5 K
outlierTest(lm.xy) #显示离群点,Bonferroni校正,残差最大的点是136号点+ c$ @1 D0 ]' G, n4 c7 x! x% v
& H4 e! ]% ^5 r% s+ N#10
) Q) b7 m6 ]7 l#删除异常值记录后重新利用多元线性回归模型拟合数据。- i7 m2 E7 ^) \9 l8 |+ s% Y9 f
data4 <- data4[-136,] #删除该点
/ Z3 T5 z V/ D0 g1 S& y1 Ox1 <- data4$x16 a4 Z' b, \* D* v% n
x2 <- data4$x2" A" d& ~) d: H- c# i
x3 <- data4$friends
* u$ T H) `. W9 [: Y: q* X. my <- data4$salary
2 p# z! r% Y: l7 i% L+ p b5 W8 zlm.xy2 <- lm(y~x1+x2+x3) #重新拟合回归模型
- M' M0 {- z* olm.xy2
1 U2 { ^% R5 n- t, O
2 [3 S4 R- A5 q#11
6 d& z3 ^7 n3 E- C' D: n0 b V" H#对#10中的多元线性回归模型进行多重共线性检验,若存在多重共线性,删除相关变量后重新进行拟合。! [0 C7 |, w- O$ S
vif(lm.xy2) #p判断多重共线性0<VIF<10(不存在)
. J+ t' F# V4 |: ]0 o% |& T, m$ @6 M X# W& L
#12
! Y8 f$ e/ |, k! }4 \# x#对#11中的结果进行解释,重点分析年龄、在北京的居住时间和朋友数量如何影响收入。
9 m0 s3 V5 u4 p9 i0 B7 S2 u- ssummary(lm.xy2) #可知年龄和朋友数量对收入有影响,显著性*一颗星
+ _: O* G- a9 v8 G0 c9 P
1 ?, v7 |/ j5 \0 R0 _**********************************************************************
- _8 w8 e/ r8 }
0 Y: j2 c4 l# T( O# z# s二、利用多元线性回归模型预测收入
w4 R7 B: ?1 j, Y6 Y$ g* WView(data4) #124条数据# U' y6 A: U' d
#12 d" a9 e/ l' S! ?6 ?' |" z
#从数据集中随机抽取50条记录作为预测集,剩下的数据作为训练集。
% z. Y k) [) k9 V3 B% h$ |train0 <- sample(nrow(data4),nrow(data4)-50) #训练集和测试集
( D' N9 L+ W5 Q3 l1 O! r" `trainData <- data4[train0,] #训练数据" S$ t6 _; q) x4 g& o2 y% B
testData <- data4[-train0,] #测试数据4 y) A* z+ R5 `8 m5 w
# w6 S; X7 x9 j
#2" E9 u; i3 [+ b4 E) b, O" o- }8 U
#针对训练集,利用多元线性回归模型拟合数据。/ U8 x. V6 P9 P8 m7 q& n4 E
lm.xy3 <- lm(trainData[,"salary"]~trainData[,"x1"]+trainData[,"x2"]+trainData[,"friends"]) d% c% u; N; z7 E
* ~: K1 X+ z( [9 L2 v9 h#3
- _: w! i) C- W" ~3 _, [) Z#对(2)中的多元线性回归模型进行诊断,处理异常值。0 Y% D4 e! c" M4 ^
summary(lm.xy3)
6 E N' f' Z$ e% hpar(mfrow=c(2,2))$ u8 G" d& M9 v4 H; Z8 C0 e7 U, {
plot(lm.xy3)' Q, H. i1 }$ p3 I1 V. Q# G
outlierTest(lm.xy3)
2 t6 O9 U p% ItrainData<-trainData[-c(150,32,82),] #删除异常值,随机的/ A" J1 Q4 M4 p8 a5 x
; a( i7 N& ~ [' v#4
0 c% l4 `. l+ Z" f7 n( c4 T#对(3)中的多元线性模型进行多重共线性检验并加以处理。3 k2 j: p0 W# b' R$ f2 S
vif(lm.xy3) #p判断多重共线性0<VIF<10(不存在)
4 c8 V& o: p' p+ `. Gsalary<-trainData[,"salary"] #引入的数据是训练集的数据
6 n- W7 i, o; q/ R2 i1 Rx2<-trainData[,"x2"]
$ V8 d, o% d: D @: ]x1<-trainData[,"x1"]/ N0 i5 O6 Z! @# |* k
friends<-trainData[,"friends"]2 {8 G0 l6 }' q M5 V
lm.xy3 <-lm(salary~x2+x1+friends)
" b3 @2 ~- e) v9 X2 O; {$ I- @4 G9 O* g) }$ `
#5
( L' g6 E" r5 u9 b, C; H( t#针对(4)中的模型,分别利用AIC和BIC选择最优模型。
" \6 \( k# c; y#AIC检验,赤池信息准则,选择最小的
0 R8 d! ]! o+ @AIClm<-step(lm.xy3,direction="both")( s) ?. U1 ]7 `6 b" f& U6 R9 |
#BIC检验,贝叶斯信息准则,选择最小的
6 V2 r) f5 v( {! K+ K3 _BIClm<-step(lm.xy3,k=log(nrow(trainData)),direction="both")0 X6 `4 K9 ~# ]6 _2 W7 R; V, V
+ x" k4 }/ @3 W/ G6 X: m7 x7 I0 \
#6* l4 o- }6 y% z2 v d; n
#利用预测集进行预测,比较全模型(包含所有自变量)、AIC选择的最优模型、BIC选择的最优模型
3 h1 }: z, n8 h#这三个模型预测的准确性大小,并进行解释。
: D7 p- f5 O2 _6 u& u3 j) V7 \9 pAllmodel<-predict(lm.xy3,testData): x% `( n% }$ ~' E
AICmodel<-predict(AIClm,testData)0 ?/ X/ k: m5 f- F; U
BICmodel<-predict(BIClm,testData), p- b6 S" W: L4 V3 l: \
#均方误差检验,最小最优,分别计算全模型,AIC,BIC的均方误差
T1 x# ?% D3 f2 o/ p/ ^ j#均方根误差亦称标准误差,均方根误差是预测值与真实值偏差的平方与观测次数n比值的平方根. _/ V$ k P! ?
#标准误差能够很好地反映出测量的精密度
6 i0 p, D- R3 k$ X' [MSE <- function(x){6 \0 ~7 u6 d% ?: V4 [
mse <- sum((testData[,"salary"]-x)^2)/506 \! g$ x% B) I7 U9 P0 e. S$ T3 f
return(mse)
; D( v e3 N6 d- P, d}
( d8 B- T' |; O! JMSE(AICmodel) #AIC/BIC/ALL是误差最小的/ ^9 T) u' U1 E+ |7 O
MSE(BICmodel)4 [# v7 l1 p/ c, G% Z Q
MSE(Allmodel)7 o+ u! U5 o i3 i
* a3 ]$ i9 r- ~3 q2 W h/ t' C
% K! h$ d4 }: K( e. i! T6 |
: Q% o9 Z; i2 U. \
作者: 试试吧 时间: 2021-10-30 17:56
好,谢谢楼主的热情分享的资料4 {6 O' H$ f6 ]$ `
| 欢迎光临 数学建模社区-数学中国 (http://www.madio.net/) |
Powered by Discuz! X2.5 |