数学建模社区-数学中国

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

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

一、背景
+ ]1 V8 u3 q# W( y: G$ y9 R1 @数据集展示了X市外来人口的相关数据情况,包括出生年月、收入、初次来到X市的日期、迁离X市的日期和现在的朋友数量。现假设外来人口的年龄、在X市的居住时间和朋友数量影响他们的收入。试加以证明。

二、要求和代码

一、分析收入的影响因素
  N; N3 q% K; n4 r( h+ x#1+ J. b) ]/ A7 F! H% M5 ^" ]: {
#展示数据集的结构
! d2 [9 l7 I( P! E0 n6 R0 E7 N$ {/ tdata2 <- read.csv(file="F:/hxpRlanguage/homework2.csv",header=TRUE,sep=",")
1 Y& ~8 r8 d$ i' X/ Mstr(data2) #显示的结果有一列是多余的,需要删除
5 j2 [, i2 o7 I! I, @; b) Sdata2 <- data2[,1:9]
9 a  Z& j1 r- _: ~str(data2) #删完之后的显示效果是正常的没有多余列
; b% B! w2 x$ f: Z: Q5 L4 T9 }- `# ^' d- ^+ a! X  Y8 ^4 ]5 C8 Z1 ~
#2  w4 u3 Y% `3 W3 h7 ?( e
#显示前10条数据记录0 W+ l1 ?% I9 |( w0 F0 q
data2[1:10,]
) h+ R# X4 n5 H0 _! m- [* w+ D6 w
3 e8 m  {& \4 h- T& @: d- q#3- ^8 f+ q" ^6 f" r0 r7 h
#将变量名重新命名为英文变量名
5 E  S, s- Z* V! r" m/ Gcnames <- c("number","birthyear","birthmonth","salary","inyear","inmonth","outyear","outmonth","friends")
. E$ i! M  L) c4 J& V+ Qcolnames(data2) <- cnames
3 [* s: |; p9 D* U+ L" fView(data2)! Y9 J* M) X; d% `$ ]: ]$ t

  R8 f; e" M6 q#4, j- R- ?* x4 G5 K; q6 E4 n
#查找数据集中居住时间小于等于0的异常记录,若存在,从数据集中删除这些异常记录
4 L! }# l6 X% ^$ ]x2 <- ((data2$outyear-data2$inyear)*12+(data2$outmonth-data2$inmonth))
# W9 B& w: Z2 S- H#View(x2) #①先算出居住时间
3 q% m7 E" O" M2 gdata3 <- cbind(data2,x2)
# n4 U- f. L+ v# |$ L! a0 ]  K#View(data3) #②使用cbind函数把x2和原数据拼成新的矩阵,方便之后删除异常数据列,并且是127条
; |2 E2 y' Z* x6 x) elist <- which(x2<=0)* @% X- d% B. i8 E7 ~
data3 <- data3[-list,]/ Q% A+ |1 Y0 r, c
View(data3) #删除异常数据后是125条数据# R  B; x+ ~5 N7 C1 @

7 b1 U2 s" |! {! {" N, z, n#5
! x% c( P8 I9 m. E0 r% C/ i# R#展示数据集中因变量与自变量的均值、最小值、中位数、最大值和标准差,要求保留2位小数。& a1 w2 @" u% t7 _- \! ^
library(lubridate)5 g5 M0 p* g9 `0 ^6 ^3 G
date<-Sys.Date() #返回系统当前的时间
7 J: s6 `. ^, d- C1 y* n9 A( fnowyear<-year(date) #提取年份9 G* ^( F: [8 l2 Z8 v
nowmonth<-month(date)  #提取月份! l  ]- X: Y$ O# j, u: C
#View(date) #查看现在的日期7 b" P3 E5 e% A) N+ q
#View(month(date)) #查看现在日期中的月份+ y6 F' g5 [7 A: T
x1 <- array(1:nrow(data3),dim=c(nrow(data3),1))5 }+ G) I. i" a9 r
for(i in c(1:nrow(data3)) ){
: _5 L+ O: x/ B7 e  r6 ^1 ^  if(nowmonth-data3[i,"birthmonth"]<0){
  q) L$ c- W: K) Y3 m" H0 X     x1[i,1] <- nowyear-data3[i,"birthyear"]-1
/ K5 ^+ S. d9 x& r. G! K: F  S  }else{/ H7 e- v8 c) D! w8 J3 n
     x1[i,1] <- nowyear-data3[i,"birthyear"]
0 l) ~2 u- j0 ?/ W$ a  }% R" I) X% n  m( {2 ]& K
}& Y  W6 j7 n8 L; X& y! Z
#View(x1) #算出年龄x1,并加入到数据表中5 C, N' i0 k- ^& P! S
data4 <- cbind(data3,x1)
9 Y$ U# `2 Z) Q2 ?View(data4) #加入x1年龄变量的新表展示' }; [- k7 r8 r: `
x2 <- data4$x2
2 y7 E6 {8 y7 p: C3 R9 uMean.x2 <- round(mean(x2),2)  \; W% |3 J9 t; y4 w* ?
Min.x2 <- round(min(x2),2)8 n: r7 _- S4 H- x( ]0 k
Max.x2 <- round(max(x2),2)  \" d& P  L5 S4 N' _2 ~/ ]
Median.x2 <- round(median(x2),2)
: H" Q4 i5 a* k% {/ u/ A) o8 xSd.x2 <- round(sd(x2),2)0 u2 d$ b+ |/ x/ e% O) q5 g
cbind(Mean.x2,Min.x2,Max.x2,Median.x2,Sd.x2) #x2居住时间的相关结果3 z6 E, j' j9 \% c
Mean.x1 <- round(mean(x1),2)
" }& ^8 n! y2 U: L  c) u  nMin.x1 <- round(min(x1),2)* w5 d' a' V" _
Max.x1 <- round(max(x1),2)
' V- z& l3 T0 FMedian.x1 <- round(median(x1),2)3 ^) ^! t7 b1 O; A7 K: l- e+ I
Sd.x1 <- round(sd(x1),2)
1 [, `+ r2 v: R; w2 Y3 x# ecbind(Mean.x1,Min.x1,Max.x1,Median.x1,Sd.x1) #x1年龄的相关结果
1 N  [8 V1 E0 {9 zx3 <- data4$friends
7 s$ P' Q0 _/ ^- g/ a2 rMean.x3 <- round(mean(x3),2)
7 l9 D, U% m- D2 V2 I' C( W0 UMin.x3 <- round(min(x3),2)" n  P6 O0 a: d5 J
Max.x3 <- round(max(x3),2)) h2 h2 h9 Y/ P- _2 T- i% f- O1 \
Median.x3 <- round(median(x3),2)
* Y$ Y7 e6 q2 y. gSd.x3 <- round(sd(x3),2)
( c; ~2 }# R6 s) H/ k9 T7 Lcbind(Mean.x3,Min.x3,Max.x3,Median.x3,Sd.x3) #x3朋友数量的相关结果
# b- o. i$ W2 t3 ]3 ky <- data4$salary  ]! j/ l: ], y. C* _
Mean.y <- round(mean(y),2)9 |; x4 x( w- P6 y1 j
Min.y <- round(min(y),2)
% t0 L: S6 K- w) z2 G+ W' AMax.y <- round(max(y),2)' B& l) j8 }; R8 E6 E& L$ N
Median.y <- round(median(y),2)
6 ?! _! n) `. Q7 u5 {% p" F3 |Sd.y <- round(sd(y),2)
& J# W) S5 N/ B' T# A4 ]. @cbind(Mean.y,Min.y,Max.y,Median.y,Sd.y) #因变量y的相关结果% D, I" }- V& C
' d' n( t9 {) p8 r# t
#68 E9 A" U' J, t# S" e; ]
#计算数据集中因变量和自变量的相关系数,要求保留2位小数。( a" x: B2 j, B7 J
round(cor(y,x1),2) #y和x1年龄2 w& Z0 f$ O% V  d
round(cor(y,x2),2) #y和x2居住时间
% b2 w) B) N# P* Q+ iround(cor(y,x3),2) #y和x3朋友数量5 h) V6 u- d( I4 q+ i. w

7 C+ c  F3 C9 f8 }% E7 Y; C#7
0 y* _9 M' K# |% t2 m: N* S% D#分别绘制数据集中因变量与各个自变量的散点图
6 D7 W2 K- v* z2 W+ p' y% f0 R5 Ypar(mfrow=c(1,3)) #布局,一行画3个图
9 d$ R. E- y4 |9 V$ a, ^! q/ Splot(x1,y,xlab="年龄x1",ylab="工资y")3 s- D0 x2 O# m3 P1 C; ^/ o, c
plot(x2,y,xlab="居住时间x2",ylab="工资y")
* q. f& I: ^3 {! r/ J. u5 Wplot(x3,y,xlab="朋友数量x3",ylab="工资y")5 _% U! P4 ^* k
, `% U5 K  z9 v( ?7 n/ F2 f
#8
' y( a2 R. w9 S7 Q4 ~; z#利用多元线性回归模型对数据集中因变量与自变量的关系进行拟合。
2 }* L! e; U4 L! m  s1 |) olm.xy <- lm(y~x1+x2+x3)
, X3 a& I# z7 ^$ _! n: B4 _lm.xy
) g; b: E' I- ]0 j  w& N4 lsummary(lm.xy) #得到的结果是方程是显著的具有线性关系,但是每一个系数不都是显著的5 F$ D: Q6 {% f

% C6 Y$ z9 U" a  d: I#9( j( ~  I; o& h, l$ l
#对#8中的多元线性回归模型进行诊断,确定异常值记录。
* ?" d) J# \7 h% Z# Spar(mfrow = c(2,2)) #生成四种模型诊断的图形,2行2列
8 e: X* @& h9 {! x9 J#生成四种模型诊断的图形:①残差与真实值的关系图 ②qq图用来检测其残差是否是正态分布
6 r) n- J8 l5 j( T& X3 w. x* U#③用来检查等方差假设的。在一开始我们的五大假设第二条便是,我们假设预测的模型里方差是一个定值。$ ?6 a6 V4 d& \% h
#如果方差不是一个定值那么这个模型的可靠性也是大打折扣的。9 S5 _9 T* B6 t2 ^) W9 j; f9 V
#④Leverage就是杠杆的意思。这种图的意义在于检查数据分析项目中是否有特别极端的点。
3 J7 ~' p9 I$ y$ z% n+ n2 ^7 xplot(lm)
' X  a/ O6 ?. V; M+ Tlibrary(carData)5 {: Z% \  c9 E# G# k9 P
library(car)' q0 m) y# m. U+ M3 T# H
outlierTest(lm.xy) #显示离群点,Bonferroni校正,残差最大的点是136号点
: _( L  n8 U6 B% i/ R* E3 \  K. C9 @2 M/ M8 D; h. T
#10
& h0 q" ]6 J1 r; X" q5 n- N#删除异常值记录后重新利用多元线性回归模型拟合数据。% U9 P2 y* {7 r9 m  @
data4 <- data4[-136,] #删除该点8 B5 H% B: {* F: ^! v3 \0 D
x1 <- data4$x1
- N5 a  n% c1 r& M* ?x2 <- data4$x28 W8 }2 g  e, @
x3 <- data4$friends
8 N, y) s+ G8 b2 x* C, f6 ~$ My <- data4$salary
& y& ^) ~+ M0 L8 Slm.xy2 <- lm(y~x1+x2+x3) #重新拟合回归模型
* x6 C- F! M) A; jlm.xy2: C. S; H& \' Z8 f2 K

2 Q7 c) k3 N4 G9 D2 e1 A#11
$ F' M4 Y) T7 ~7 \$ d#对#10中的多元线性回归模型进行多重共线性检验,若存在多重共线性,删除相关变量后重新进行拟合。2 T- r+ Q* R" s& i1 u" A
vif(lm.xy2) #p判断多重共线性0<VIF<10(不存在)
- O5 u/ G% D' y; l# U5 p4 o
) h. m3 w, B. |' i. c( ~/ _6 {8 `#12
8 ~/ ~: F, s  P7 f. i1 ^* T9 X#对#11中的结果进行解释,重点分析年龄、在北京的居住时间和朋友数量如何影响收入。& J: N2 A- M  \$ e4 C1 r
summary(lm.xy2) #可知年龄和朋友数量对收入有影响,显著性*一颗星* D9 {4 p7 B: {, C& V' i

4 M. u% @& B$ |  s: H9 n% m' D2 J**********************************************************************
2 {3 h, L; C' ]! f7 A  n. O; H3 W( p, ?/ E+ A* _
二、利用多元线性回归模型预测收入# o  q7 m7 F( b4 E# D* W
View(data4) #124条数据4 v6 I- x0 K! l) ^) {+ J4 A9 ?
#1
  N7 c) p$ \) ~! J3 S: Y#从数据集中随机抽取50条记录作为预测集,剩下的数据作为训练集。
& d. \3 A$ Y; f8 p0 P+ Ytrain0 <- sample(nrow(data4),nrow(data4)-50) #训练集和测试集
0 J8 e6 z! o* G: j; c1 N* KtrainData <- data4[train0,] #训练数据0 o' I6 }7 q$ x$ N: h( B! V
testData <- data4[-train0,] #测试数据
! \1 O8 O/ I/ X, H
) n' D9 q( K6 L' N& N5 l3 x9 }#2! K/ |4 H' b6 d5 {; x
#针对训练集,利用多元线性回归模型拟合数据。
- }) I+ R7 x* k* n5 _% zlm.xy3 <- lm(trainData[,"salary"]~trainData[,"x1"]+trainData[,"x2"]+trainData[,"friends"])
& O% s4 _; Y6 q0 M, n2 X* `0 `5 Y4 |
#3% m' h+ M* w6 K- t7 h
#对(2)中的多元线性回归模型进行诊断,处理异常值。  l( B4 |& n6 d$ A& b! G
summary(lm.xy3)) H& J* }2 Y. E5 x8 I9 ^
par(mfrow=c(2,2))8 O2 k% L  ~5 r/ o* J; ]
plot(lm.xy3), @$ i9 n6 i! R+ R
outlierTest(lm.xy3)  @& X0 B: l' F$ O0 s1 [
trainData<-trainData[-c(150,32,82),] #删除异常值,随机的. p, z- Q; b6 J1 D( Y$ I3 b* S
; j, G6 j+ H( g& _( `0 e
#44 v: w# _, D, Q; T, v) L/ K) R
#对(3)中的多元线性模型进行多重共线性检验并加以处理。
; S) G; F" ^" J+ w& [3 P. ^( M# Pvif(lm.xy3) #p判断多重共线性0<VIF<10(不存在)
: n, V( c8 z& L' q1 isalary<-trainData[,"salary"] #引入的数据是训练集的数据
6 @9 A4 z4 t5 g! Mx2<-trainData[,"x2"]
  w2 j$ ~( O. D$ D( O. {; L4 S7 ix1<-trainData[,"x1"]
  c) w" L0 [9 wfriends<-trainData[,"friends"]
( |1 z( v7 b2 J6 m: z9 b7 s% g  wlm.xy3 <-lm(salary~x2+x1+friends)
% Z& d, u" m4 h( G: z+ R8 F8 s) O; Q7 v0 c4 e* [
#52 T1 c( S1 J/ P  g8 T. p( [
#针对(4)中的模型,分别利用AIC和BIC选择最优模型。
8 ?- E) G" {. C3 g  `) ^#AIC检验,赤池信息准则,选择最小的' H: a9 C) J- e& ~
AIClm<-step(lm.xy3,direction="both")' _# w7 u# O- \& Y) U
#BIC检验,贝叶斯信息准则,选择最小的6 y; @9 S1 i8 [/ _( ^" L1 Y
BIClm<-step(lm.xy3,k=log(nrow(trainData)),direction="both")! S% G8 K3 O3 j* a( B

1 T: l  i" j" V/ N" H9 J#6! P* ?- R( p9 F/ [5 X
#利用预测集进行预测,比较全模型(包含所有自变量)、AIC选择的最优模型、BIC选择的最优模型' W0 |8 g, V2 I1 f
#这三个模型预测的准确性大小,并进行解释。
( i+ V2 X. `! ?( a0 |9 @, b& p6 gAllmodel<-predict(lm.xy3,testData)3 [# V; F/ d" c' A
AICmodel<-predict(AIClm,testData)3 C8 ]* i* a& C, ~( E$ e7 ~: ~
BICmodel<-predict(BIClm,testData)
' `$ z2 l9 Z/ X/ n8 f7 _#均方误差检验,最小最优,分别计算全模型,AIC,BIC的均方误差
6 d9 B; T- t4 R#均方根误差亦称标准误差,均方根误差是预测值与真实值偏差的平方与观测次数n比值的平方根) R5 ^. t: c% n6 H$ S" ?  N3 F# H
#标准误差能够很好地反映出测量的精密度' Q- V" V! @3 W2 a+ g# y, S
MSE <- function(x){0 V, T9 V6 t/ |/ P9 |* K: N! ~
  mse <- sum((testData[,"salary"]-x)^2)/504 D9 f. e* L' w8 m
  return(mse)
0 q  V8 x6 `$ G5 l$ ?9 B}
) Q8 E& ^  V) q+ A, F/ C0 n8 D1 Q$ t' {MSE(AICmodel) #AIC/BIC/ALL是误差最小的
) h3 k8 O2 Q- K+ I1 L$ D+ N8 qMSE(BICmodel)
1 ?% `& N( I  o$ Z0 P& k2 FMSE(Allmodel)
2 p+ H! C3 R" l- _( a4 i/ h3 p6 p

/ u) T; T# Z" L  K# o
+ Y, M9 l! r( o) ?  M
作者: 试试吧    时间: 2021-10-30 17:56
好,谢谢楼主的热情分享的资料* W9 L4 A9 D: Q1 X3 z' [5 V& F7 V





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