数学建模社区-数学中国

标题: 【高级数理统计R语言学习】2 多元线性回归 [打印本页]

作者: 1047521767    时间: 2021-10-29 11:44
标题: 【高级数理统计R语言学习】2 多元线性回归
【高级数理统计R语言学习】2 多元线性回归

一、背景! F6 H- I  S" ?. e4 q" Y) W5 _
数据集展示了X市外来人口的相关数据情况,包括出生年月、收入、初次来到X市的日期、迁离X市的日期和现在的朋友数量。现假设外来人口的年龄、在X市的居住时间和朋友数量影响他们的收入。试加以证明。

二、要求和代码

一、分析收入的影响因素
% g; i/ E0 _- ~& L- D4 ~0 |#1* b: i) R; W9 j: _
#展示数据集的结构2 N8 S6 \, r& X5 q0 u5 V; C8 y
data2 <- read.csv(file="F:/hxpRlanguage/homework2.csv",header=TRUE,sep=",")
5 A! U  p# u2 S5 nstr(data2) #显示的结果有一列是多余的,需要删除0 ~& F* s* m7 B# F
data2 <- data2[,1:9]
1 f& Z4 @3 }; m& p/ @str(data2) #删完之后的显示效果是正常的没有多余列$ J9 _+ y0 [2 A. Q+ y
3 T. t7 j0 D/ n6 @  \: d
#2
1 L% e- Q" n; N, O#显示前10条数据记录
1 J  }' e' W% ?& y; E- Bdata2[1:10,]. p$ P( P, ~2 I& f3 g: j
6 K) l# I: z$ I; ]
#3
) V  q) ^7 H8 o9 _# H/ K#将变量名重新命名为英文变量名
, e" M) j) V: i) acnames <- c("number","birthyear","birthmonth","salary","inyear","inmonth","outyear","outmonth","friends")
4 ?% N  Y- a7 f, T( S; l! T7 \colnames(data2) <- cnames) m( ~+ u' @# D- B9 e+ U6 i( g7 `# ^
View(data2)7 n3 F7 O* b( b" c9 {0 {( t9 l

: h; q6 o1 y  `" a# [& H- E7 S#4
5 Y) u* P$ ~& A#查找数据集中居住时间小于等于0的异常记录,若存在,从数据集中删除这些异常记录3 M) q1 B1 F1 C4 \; ?
x2 <- ((data2$outyear-data2$inyear)*12+(data2$outmonth-data2$inmonth))# p: V0 n- M4 M6 e$ o: O
#View(x2) #①先算出居住时间) N6 J8 I( a  G$ o% w3 [
data3 <- cbind(data2,x2)
4 U* I+ _3 A2 R  U& G#View(data3) #②使用cbind函数把x2和原数据拼成新的矩阵,方便之后删除异常数据列,并且是127条" D# H5 a+ r+ Z* d
list <- which(x2<=0)$ k; J! Y5 S( x1 S8 J, E
data3 <- data3[-list,]: r, _  u) C/ ^3 @' E2 k/ e- X
View(data3) #删除异常数据后是125条数据
" y$ f2 H! K" O4 H# K; F# C. p5 W* c$ \7 U7 S" ]: |5 C: D% ~
#5
4 X: b6 L, N0 U$ d0 R% }8 c* ?1 y#展示数据集中因变量与自变量的均值、最小值、中位数、最大值和标准差,要求保留2位小数。
! F- ~3 e! J) ^( k; Llibrary(lubridate)
5 M# V; e( u0 ^2 R! jdate<-Sys.Date() #返回系统当前的时间
2 h/ U' h/ Z( v- [7 P' snowyear<-year(date) #提取年份1 r( _6 G8 l6 a9 X0 M- [+ f
nowmonth<-month(date)  #提取月份9 k; f0 H4 b: `' K
#View(date) #查看现在的日期
7 o7 W/ N# S* d" Z3 M6 y# |#View(month(date)) #查看现在日期中的月份0 r1 C1 h0 O4 v! O1 n  e
x1 <- array(1:nrow(data3),dim=c(nrow(data3),1))
7 l6 Y9 P+ a9 ^# Ofor(i in c(1:nrow(data3)) ){. \, |1 f' w  C( B( l& P! t
  if(nowmonth-data3[i,"birthmonth"]<0){( J9 W$ o8 Z8 w; W1 Q- k: [
     x1[i,1] <- nowyear-data3[i,"birthyear"]-1
' G, l  V) B/ [8 Q: Y% B; J  }else{  }; n4 F( t3 y- b2 g! n  t
     x1[i,1] <- nowyear-data3[i,"birthyear"]; _" R0 k: B: P8 t, b6 H& s/ r0 ^
  }6 X( G+ U  J. A# A! K
}  V) X( \; H  Y
#View(x1) #算出年龄x1,并加入到数据表中, S' I; ~; O) f6 E
data4 <- cbind(data3,x1) 5 s6 m# L, G& @6 T6 t* y
View(data4) #加入x1年龄变量的新表展示
# y# F% j: g: z; |2 |8 z8 S) Y, h3 G: Wx2 <- data4$x21 W. M9 U. t# ?
Mean.x2 <- round(mean(x2),2)
+ f" J4 e  H& g% L: x! ~, OMin.x2 <- round(min(x2),2)  i$ n5 B) q( P; ?9 d  P) @
Max.x2 <- round(max(x2),2)
* X$ h8 J; ~, V5 `Median.x2 <- round(median(x2),2)
* \+ X  Z/ J1 K) s0 z" S" hSd.x2 <- round(sd(x2),2)
3 y# S7 f2 X0 _1 Ucbind(Mean.x2,Min.x2,Max.x2,Median.x2,Sd.x2) #x2居住时间的相关结果
2 G- P: U! h1 c) c7 p; IMean.x1 <- round(mean(x1),2)
1 o9 S7 c3 a9 @! W  Y9 y5 u8 nMin.x1 <- round(min(x1),2)
. ?; D2 M, D5 ?4 c$ EMax.x1 <- round(max(x1),2): r0 d; ~% G$ Y" A( N5 ~
Median.x1 <- round(median(x1),2)* I# |- `5 o" f" }/ M
Sd.x1 <- round(sd(x1),2)' W  ^1 E6 W2 W5 K* R5 ~4 M
cbind(Mean.x1,Min.x1,Max.x1,Median.x1,Sd.x1) #x1年龄的相关结果
$ |3 N3 P0 ]4 ^x3 <- data4$friends" F: Y( f- Z. o  ]! t
Mean.x3 <- round(mean(x3),2)
5 C% o9 r7 Q2 {& R: rMin.x3 <- round(min(x3),2)
$ V$ `% R3 Z1 m' \3 ~6 p8 uMax.x3 <- round(max(x3),2)
" r. \4 s; F' j8 b( P, BMedian.x3 <- round(median(x3),2)0 J( x# j! ?9 J* O6 U4 y* m2 f) O
Sd.x3 <- round(sd(x3),2): F+ `  f" O! N% F: J
cbind(Mean.x3,Min.x3,Max.x3,Median.x3,Sd.x3) #x3朋友数量的相关结果
, l5 c) U- A+ ?, |7 J) Ty <- data4$salary% h9 e: B; r/ A
Mean.y <- round(mean(y),2)6 b' X% z' C' n! \6 m
Min.y <- round(min(y),2)
2 K6 K8 q, P% W, Z) h( vMax.y <- round(max(y),2)
% W$ e8 P6 r! U+ BMedian.y <- round(median(y),2)
% T. b! G$ A. D% GSd.y <- round(sd(y),2)/ M  K0 I8 N- G5 z  O  N
cbind(Mean.y,Min.y,Max.y,Median.y,Sd.y) #因变量y的相关结果
" ]% C; ~6 N6 o. n6 B0 V8 v: v+ J9 ]6 v, O+ A( I4 s4 c
#6
4 o/ E  x$ ~; M9 H4 Z#计算数据集中因变量和自变量的相关系数,要求保留2位小数。
+ Z+ Q+ W; `6 E. A, Qround(cor(y,x1),2) #y和x1年龄
( I" `. w. v% H, g! K' @- W1 eround(cor(y,x2),2) #y和x2居住时间
8 A/ x* R" {9 @& H# _) Iround(cor(y,x3),2) #y和x3朋友数量! c& a& _, I! v* F
& L% w3 o" P/ r0 G
#7
% A% y) H4 S7 X4 _" B#分别绘制数据集中因变量与各个自变量的散点图2 Z/ z) N0 J; A6 M4 y
par(mfrow=c(1,3)) #布局,一行画3个图
& ^2 m% b# y4 A- Z& Uplot(x1,y,xlab="年龄x1",ylab="工资y")
& Y. C* d0 E8 {0 ^plot(x2,y,xlab="居住时间x2",ylab="工资y")7 c2 Q+ p8 k& r& ^) N) ^9 U
plot(x3,y,xlab="朋友数量x3",ylab="工资y")7 `2 v4 v4 d% W) l$ s# o; k

0 A3 G9 {1 V! X0 u4 z#81 y. d( b4 V: o, x1 ~
#利用多元线性回归模型对数据集中因变量与自变量的关系进行拟合。  l" I5 c% ]$ D# A7 q, C+ }
lm.xy <- lm(y~x1+x2+x3)# B' E3 V/ z+ E! M
lm.xy! Y9 n2 u% l5 v
summary(lm.xy) #得到的结果是方程是显著的具有线性关系,但是每一个系数不都是显著的
+ r0 I. y2 ^* D% X
9 T. ^' n3 {" J9 |7 z: L#9$ U5 i1 ?, L9 x; Z' e4 j2 B
#对#8中的多元线性回归模型进行诊断,确定异常值记录。
8 Z  z! X; g4 Q9 d' vpar(mfrow = c(2,2)) #生成四种模型诊断的图形,2行2列
  e: ^6 \1 M5 n+ T' t3 \% C  D#生成四种模型诊断的图形:①残差与真实值的关系图 ②qq图用来检测其残差是否是正态分布
* }! v' u& I8 b$ K9 K8 V6 X#③用来检查等方差假设的。在一开始我们的五大假设第二条便是,我们假设预测的模型里方差是一个定值。
% j/ p- |  b4 R7 U: B% P#如果方差不是一个定值那么这个模型的可靠性也是大打折扣的。3 @0 F2 K' H2 m# c% Y
#④Leverage就是杠杆的意思。这种图的意义在于检查数据分析项目中是否有特别极端的点。
. `/ \9 o0 _/ P, Nplot(lm)/ u# f. ?' y5 c) f4 q
library(carData)
8 Q, h; ~. T3 x5 S) K# M& |library(car)
8 [# \9 U8 D  b! U3 w5 LoutlierTest(lm.xy) #显示离群点,Bonferroni校正,残差最大的点是136号点
) p& k' ?# v3 F6 h: G3 A4 T) Q$ [  y# t. p5 s3 @( U& j
#10
& I6 w) n+ z; k: v1 S! o#删除异常值记录后重新利用多元线性回归模型拟合数据。7 W% M4 P* c4 y6 w. k
data4 <- data4[-136,] #删除该点
  h2 F) |. H/ G& X5 N1 F5 T! Px1 <- data4$x1! h$ A$ [1 W% F$ t4 O7 [$ G
x2 <- data4$x21 }& ~  q+ ^$ H
x3 <- data4$friends
* N/ x5 Z" j7 i) o( ry <- data4$salary
" D* Q" l: i+ ~! jlm.xy2 <- lm(y~x1+x2+x3) #重新拟合回归模型. [* f. z0 g, G/ V( i
lm.xy2* z% A6 Q$ j; ?. F
* a. d* D  G7 F# I( c) q
#11
; Z+ p4 ~1 v$ ?2 Y  S#对#10中的多元线性回归模型进行多重共线性检验,若存在多重共线性,删除相关变量后重新进行拟合。! I+ z# C/ ^: K3 t8 b4 s9 [
vif(lm.xy2) #p判断多重共线性0<VIF<10(不存在), K. `, C- N/ t5 e% j* c

0 V" j9 m4 R1 L; S#12- r6 ^/ Q3 S7 @0 R
#对#11中的结果进行解释,重点分析年龄、在北京的居住时间和朋友数量如何影响收入。
' S  W( Y0 S& B: _+ }summary(lm.xy2) #可知年龄和朋友数量对收入有影响,显著性*一颗星
; B1 @' Y! R5 p) t5 K, e  D
# L$ q( ?& Y1 ?8 l**********************************************************************8 _  A* e3 G8 d: f2 }" h  {

+ s# o: I* x, p1 P. _4 Z# c. ]二、利用多元线性回归模型预测收入" V- O: v: n8 k
View(data4) #124条数据* G% _7 N2 U# i
#1
- h7 P5 X* H. @; z#从数据集中随机抽取50条记录作为预测集,剩下的数据作为训练集。
: h: r0 h0 p) D+ {train0 <- sample(nrow(data4),nrow(data4)-50) #训练集和测试集
5 r5 }0 j) n0 B% ctrainData <- data4[train0,] #训练数据
/ |( V- M1 q3 ]( NtestData <- data4[-train0,] #测试数据
$ s8 Q0 R7 F3 X; f4 x
! h5 u8 ?6 X2 \. ?* z% }. m. r: A#2
% |# r9 `. Y. D! a4 Y#针对训练集,利用多元线性回归模型拟合数据。' t! M7 l8 j, ~; S
lm.xy3 <- lm(trainData[,"salary"]~trainData[,"x1"]+trainData[,"x2"]+trainData[,"friends"]). |2 \) B: h: L, |: y9 y

" N4 Y1 u% e' |4 A" n" r. m3 J5 D#3  m, J/ L. c; ]6 H) {3 d+ q6 n
#对(2)中的多元线性回归模型进行诊断,处理异常值。) ^5 U& ?6 @/ ~; Y2 Z2 ~/ s" B: d
summary(lm.xy3). U+ _/ Z5 s( m8 A9 D- P0 ^& ?
par(mfrow=c(2,2))! h8 b5 H3 m. z. w/ h
plot(lm.xy3)
6 P2 S  ^+ V9 v5 f, HoutlierTest(lm.xy3)
$ U& |! ?0 B4 X: C! WtrainData<-trainData[-c(150,32,82),] #删除异常值,随机的! r- Q+ _; Y6 ^' y9 E

1 G2 x$ b  Z& @* q6 `9 {7 V#49 l0 t2 t/ _, M5 }4 I) G! h0 t
#对(3)中的多元线性模型进行多重共线性检验并加以处理。, u2 `0 S. G, w) J* Y/ P! \
vif(lm.xy3) #p判断多重共线性0<VIF<10(不存在)
2 z  Y. T; _* S2 E' ~1 ksalary<-trainData[,"salary"] #引入的数据是训练集的数据! H* o" G( y$ d+ o( X3 h4 c
x2<-trainData[,"x2"]
( w# i% S& z& ax1<-trainData[,"x1"]
, e& \6 L, W; c( e' |' s3 ifriends<-trainData[,"friends"]
# w6 ^8 W+ p3 ?! l: W) v9 [3 Plm.xy3 <-lm(salary~x2+x1+friends)" E4 b; J' z: X$ N$ X1 v' Q) h

% E+ W# S. W2 ?$ B) {; T#58 m/ Y7 w( v( q2 q. U% n, N, K
#针对(4)中的模型,分别利用AIC和BIC选择最优模型。! [/ Y6 B+ l. c% c' z8 ~6 ]  b. C
#AIC检验,赤池信息准则,选择最小的; M& K$ k$ q9 e4 g/ F$ g
AIClm<-step(lm.xy3,direction="both")+ ]7 v2 o; s3 k0 A; D
#BIC检验,贝叶斯信息准则,选择最小的0 {  ^% b' z6 B& [( F
BIClm<-step(lm.xy3,k=log(nrow(trainData)),direction="both")5 O- K' u0 E7 O

' p$ v+ D6 d* j#6
8 ?3 I" B$ H- [% z/ ^+ x#利用预测集进行预测,比较全模型(包含所有自变量)、AIC选择的最优模型、BIC选择的最优模型
1 G* k  b7 h* ^! e8 C" }#这三个模型预测的准确性大小,并进行解释。" f+ r1 L0 g( ^# Q: g
Allmodel<-predict(lm.xy3,testData)( Z$ b3 R' a  u$ R5 c$ e
AICmodel<-predict(AIClm,testData)
3 j$ C/ H" j( x( c2 i& |9 V  _; QBICmodel<-predict(BIClm,testData)5 u6 r) S8 A" j7 ^9 U
#均方误差检验,最小最优,分别计算全模型,AIC,BIC的均方误差
6 T9 B1 g, X. H) E- o- s) ]6 ~) S#均方根误差亦称标准误差,均方根误差是预测值与真实值偏差的平方与观测次数n比值的平方根
# A+ S8 v0 w: m0 T#标准误差能够很好地反映出测量的精密度
* p& |9 @/ G0 M' D' K8 a* UMSE <- function(x){3 b6 B+ w. C& {$ S3 m) s
  mse <- sum((testData[,"salary"]-x)^2)/50
8 v7 l" k7 U0 Z  return(mse)
4 o0 ^4 [2 ~4 j6 U. }/ G8 n3 b}
7 @2 k& y; g) Z5 pMSE(AICmodel) #AIC/BIC/ALL是误差最小的. N2 e: A: F$ A& J# S+ q" w
MSE(BICmodel)* E) M* R* j) k
MSE(Allmodel)
# a8 B% L) t# Z( F) g: }) ^) m$ L8 I; X, i

( q. b' N8 ^5 O- Q/ c; ]  m" M+ f; b: o2 P& Q, Z

作者: 试试吧    时间: 2021-10-30 17:56
好,谢谢楼主的热情分享的资料! u& V; j; |/ O2 V4 k% a





欢迎光临 数学建模社区-数学中国 (http://www.madio.net/) Powered by Discuz! X2.5