多元统计分析及R语言建模-第4章 相关分析与回归分析及R使用

# 第4章 相关分析与回归分析及R使用


# 4.1一元线性回归分析
# 4.1.1 简单相关分析的R计算
x1 <- c(171,175,159,155,152,158,154,164,168,166,159,164)  # 身高
y2 <- c(57,64,41,38,35,44,41,51,57,49,47,46)  # 体重
plot(x1, y2)
lxy <- function(x,y){
  n=length(x)
  return(sum(x*y)-sum(x)*sum(y)/n)
}
# 计算pearson相关系数
r <- lxy(x1,y2)/sqrt(lxy(x1,x1)*lxy(y2,y2))   # 直接计算

cor(x1, y2, method=c("pearson"))              # 调用函数计算

Pearson相关系数计算公式：R(X,Y) = cov(X,Y) / [sd(X)*sd(Y)]

# 假设检验相关系数r是否显著
# 计算t值
t <- r/sqrt((1-r^2)/(length(x1)-2))  # 直接计算
cor.test(x1,y2)                      # 调用函数计算t值和p值


# 4.1.2 一元线性回归分析的R计算
b <- lxy(x1,y2)/lxy(x1,x1)           # 计算回归系数b
a <- mean(y2) - b*mean(x1)           # 计算截距a
plot(x1,y2)                      # 画散点图
lines(x1,a+b*x1)                 # 作回归直线


# 回归系数的假设检验
# 方差分析
SST <- lxy(y2,y2)     # y2实测值的离均差平方和
SSR <- b*lxy(x1,y2)   # x1对y2的线性影响
SSE <- SST - SSR
MSR <- SSR/1          # 这里是指回归自由度为1
MSE <- SSE/(length(x1)-2)      # length(x1)-2为误差自由度
F <- MSR/MSE
# F_0.95(1,22)=4.3,由于F=115.4>4.3，所以有P<0.01，于是在alpha=0.05水平处拒绝H_0，及回归系数有统计学意义，x1与y2之间存在直线回归关系


# t检验
sy.x <- sqrt(MSE)
sb <- sy.x/sqrt(lxy(x1,x1))
t <- b/sb      # 计算t值


# 调用系统函数
# 构建线性回归模型
lm <- lm(y2~x1)
# 模型的方差分析，即F检验，观察Pr(>F)值的显著性
anova(lm)
# 回归系数的t检验，观察Pr(>|t|)值的显著性
summary(lm)




# 4.2 多元线性回归分析


# 4.2.1 多元线性回归模型的建立
# 读取数据
data<-read.table("clipboard",header=T)
# 将data对象附加到R的搜索路径，因此可直接通过名称来访问数据
attach(data)
# 构建多元线性回归模型
lm <- lm(saleAmount ~ registerUsers+newTransUsers+bigOrders+backAmount)
# 计算标准化偏回归系数，结果应落在（-1，1）内，越接近1，说明该自变量对因变量得线性影响越大
coefficients(lm)[3]*(sd(newTransUsers)/sd(saleAmount))
coefficients(lm)[4]*(sd(bigOrders)/sd(saleAmount))
coefficients(lm)[5]*(sd(backAmount)/sd(saleAmount))


# 4.2.2  多元线性回归模型的检验
anova(lm)
summary(lm)


# 定义求残差平方和函数RSS
RSS <- function(x){
  sum <- 0
  for(i in 1:length(x))
    sum <- sum + x[i]*x[i]
  sum
}


# 4.3 多元线性相关分析
# 4.3.1 矩阵相关分析
# 构建矩阵
mat <- cbind(saleAmount,  registerUsers,   newTransUsers,   bigOrders,   backAmount)
# 计算变量两两之间的相关系数
cor(mat)
# 画矩阵散点图
pairs(mat)
# 相关系数的假设检验
cor.test(saleAmount,  bigOrders)


# 4.3.2 复相关分析
lm <- lm(saleAmount ~ registerUsers+newTransUsers+bigOrders+backAmount)
# 复相关系数为R
sqrt(summary(lm)$r.sq)
#  决定系数为R平方，越接近1越好
summary(lm)$r.sq


# 4.4 回归变量的选择方法


# 4.4.1 变量选择准则
# 1.全局择优法  挑出残差平方和RSS最小、R平方最大的变量
library(leaps)
varsel <- regsubsets(saleAmount ~ registerUsers+newTransUsers+bigOrders+backAmount,data=data)
result <- summary(varsel)
data.frame(result$outmat,RSS=result$rss,R2=result$rsq)
# BIC准则，挑出Cp和BIC最小的变量
data.frame(result$outmat,RSS=result$rss,R2=result$rsq,adjR2=result$adjr2,Cp=result$cp,BIC=result$bic)


# 4.4.2 逐步回归分析法
# 一般来说，可以直接取F_进=F_出=F*=3.84或2.71.当然，为了回归方程中还能多进入一些自变量，甚至也可以取为2.0或2.5.
lm <- lm(saleAmount ~ registerUsers+newTransUsers+bigOrders+backAmount)
# 向前引入法
lm.step <- step(lm,direction="forward")
# 向后剔除法
lm.step <- step(lm,direction="backward")
# 逐步筛选法
lm.step <- step(lm,direction="both")




# 4.5 非线性回归模型


# 4.5.1 一元非线性回归模型及其应用
# （1）根据可替换模型，分别建立各自转化后的曲线模型
# （2）分析各模型的F检验值，观察显著性，剔除不显著的模型
# （3）对表现为显著或极显著的模型，检查模型系数的t检验值，不显著的也予以剔除
# （4）再列表比较模型决定系数R平方值的大小，R平方越大的，表示其经该代换后，曲线关系越密切
# （5）选取R平方值最大的模型作为最优化模型
x <- c(1.5,2.8,4.5,7.5,10.5,13.5,15.1,16.5,19.5,22.5,24.5,26.5)
y <- c(7.0,5.5,4.6,3.6,2.9,2.7,2.5,2.4,2.2,2.1,1.9,1.8)
plot(x,y)
# 下面分别来拟合这些可替换模型
# 1）直线回归
lm.1 <- lm(y~x)
# t检验
summary(lm.1)$coef
# 决定系数
summary(lm.1)$r.sq
# 加回归线
abline(lm.1)
# R平方=0.7964说明拟合的效果不佳


# 2）多项式回归
x2 <- x^2
lm.2 <- lm(y~x+x2)
# t检验
summary(lm.2)$coef
# 决定系数
summary(lm.2)$r.sq
# 加回归线
plot(x,y);lines(x,fitted(lm.2))
# R平方=0.9513说明拟合的效果比一次函数好


# 3）对数法
# 拟合对数曲线，并进行t检验
lm.log <- lm(y~log(x)); summary(lm.log)$coef
# 决定系数
summary(lm.log)$r.sq
# 加对数回归线
plot(x,y); lines(x,fitted(lm.log))
# 该模型的拟合优度R平方=0.9854，接近于1，说明拟合效果已经很好了


# 4）指数法
# 拟合指数曲线，并进行t检验
lm.exp <- lm(log(y)~x); summary(lm.exp)$coef
# 决定系数
summary(lm.exp)$r.sq
# 加指数回归线
plot(x,y); lines(x,exp(fitted(lm.exp)))
# 该模型的拟合优度R平方=0.9153，大于0.90，说明拟合效果尚可，但不如对数曲线效果好


# 5）幂函数法
# 拟合幂函数曲线，并进行t检验
lm.pow <- lm(log(y)~log(x)); summary(lm.pow)$coef
# 决定系数
summary(lm.pow)$r.sq
# 加幂函数回归线
plot(x,y); lines(x,exp(fitted(lm.pow)))
# 该模型的拟合优度R平方=0.9938，非常接近1，说明拟合效果非常好


# 4.5.3 多元非线性模型的计算
x <- c(1.5,2.8,4.5,7.5,10.5,13.5,15.1,16.5,19.5,22.5,24.5,26.5)
y <- c(7.0,5.5,4.6,3.6,2.9,2.7,2.5,2.4,2.2,2.1,1.9,1.8)
# 对x,y应用非线性拟合函数nls(formula, data, start, ...)进行回归分析
# 初始值start的选择是难点，通常可用线性模型的结果作为非线性模型的初始值
summary(lm(y~x))$coef
# 1）拟合直线
(S1 <- nls(y~a+b*x, start=list(a=5.60,b=-0.17)))
# 加回归线
plot(x,y); lines(x,fitted(S1))
# 残差平方和5.931


# 2）拟合对数曲线
(S2 <- nls(y~a+b*log(x), start=list(a=5.60,b=-0.17)))
# 加回归线
plot(x,y); lines(x,fitted(S2))
# 残差平方和0.4261


# 3）拟合指数曲线
(S3 <- nls(y~a*exp(b*x), start=list(a=5.60,b=-0.17)))
# 加回归线
plot(x,y); lines(x,fitted(S3))
# 残差平方和2.486


# 4）拟合幂函数曲线
(S4 <- nls(y~a*(x^b), start=list(a=5.60,b=-0.17)))
# 加回归线
plot(x,y); lines(x,fitted(S4))
# 残差平方和0.1645


# 例4-9
# 某公司季度销售数据
# 各季度
t <- c(1:12)
# 销售额（万元）
Y <- c(26.74,34.81,44.72,57.46,73.84,88.45,105.82,126.16,150.95,181.58,204.26,222.84)
# 销售人员（人）
L <- c(26,28,32,36,41,45,48,52,56,60,66,70)
# 销售费用（万元）
K <- c(23.66,30.55,38.12,46.77,56.45,67.15,78.92,91.67,105.47,121.32,128.56,132.47)
# 构建数据框
d4.8 <- data.frame(t,Y,L,K)
(model <- nls(Y~A0*(exp(m*t))*(L^a)*(K^b),data=d4.8, start=list(A0=0.45,m=0,a=0.5,b=0.5)))
# 模型t检验
summary(model)
# 从检验结果来看，效果不错，各回归系数都显著Pr(>|t|)<0.05，标准差（1.056）较小
# 预测第13季度的销售额
predict(model,newdata=data.frame(t=13,L=75,K=135),interval="confidence")


# 例子：财政收入的多因素分析
# 读数据
# 读取数据
case4 <- read.table("clipboard",header=T)
attach(case4)
# 查看前几行数据
head(case4)
# 画散点图
plot(case4)
# 计算各变量两两之间的相关系数
cor(case4)
# 相关系数的t检验
corr.test <- function(x){
  mat <- c()
  for(i in (1:length(x))){
    row <- c()
    for(j in (1:length(x))){
      if(i<=j)
        row <- c(row,cor.test(case4[,i],case4[,j])$p.v)
      else
        row <- c(row,cor(x[i],x[j]))
    }
    mat <- rbind(mat,row)
  }
  mat
}


# 建立回归模型
lm <- lm(y~x1+x2+x3+x4+x5+x6+x7+x8+x9, data=case4); lm; anova(lm)
# t检验
summary(lm)
# 实际值、模型预测值、误差百分比
y <- case4$y; yhat <- lm$fit; resid <- lm$resid
cbind(y,yhat,resid,rerror=resid/yhat*100)
# 加回归线
t <- rownames(case4); plot(t,y); lines(t,yhat)
# 逐步筛选法选出最优自变量子集
lm.step <- step(lm,direction="both")
lm <- lm(y~x1+x2+x3+x4+x6+x8, data=case4); lm
# t检验
summary(lm)
# 实际值、模型预测值、误差百分比
y <- case4$y; yhat <- lm$fit; resid <- lm$resid
cbind(y,yhat,resid,rerror=resid/yhat*100)
# 加回归线
t <- rownames(case4); plot(t,y); lines(t,yhat)
# 方差分析
anova(lm)