R语言实战-第十三章 R in action-chapter13

#第13章 广义线性模型
#用来分析非正态的响应变量 包括分类数据和离散的计数型数据

library(robust)
library(qcc)
#logistic回归适用于二值响应变量(0和1)
#泊松分布适用于在给定时间内响应变量为事件发生数目的情形
#logistic回归
#以AER()包中的数据框Affairs为例
library(AER)
data("Affairs",package="AER")
summary(Affairs)
table(Affairs$affairs)
#将婚外情的次数转化为二值型结果(有/无婚外情) 然后可以用作logistic回归的结果变量
#通过预测变量gender age yearsmarried children religiousness education 
#occupation rating 来预测二值型结果变量
Affairs$ynaffairs[Affairs$affairs>0] <- 1
Affairs$ynaffairs[Affairs$affairs==0] <- 0
Affairs$ynaffairs <- factor(Affairs$ynaffairs,
                            levels = c(0,1),
                            labels = c("No","Yes"))
table(Affairs$ynaffairs)
fit.full <- glm(ynaffairs~gender+age+yearsmarried+children+religiousness+
                  education+occupation+rating,data = Affairs,family = binomial())
summary(fit.full)
#结果显示gender+children+education+occupation对方程的贡献率不显著 去除这些变量重新拟合模型

fit.reduced <- glm(ynaffairs~age+yearsmarried+religiousness+rating,
                data = Affairs,family = binomial())
summary(fit.reduced)
#拟合后的系数都很显著
 
#对两种拟合方式进行比较 对于广义线性回归 可以用卡方检验
anova(fit.full,fit.reduced,test = "Chisq")
#结果显示 两个拟合模型没有显著差异 可见gender+children+education+occupation
#不会提高方程的预测精度 因此选择更简单的模型进行解释

#解释模型参数
coef(fit.reduced)
#(Intercept)           age  yearsmarried religiousness        rating 
#1.93083017   -0.03527112    0.10062274   -0.32902386   -0.46136144

#在logistic回归中 回归系数的含义是当其他预测变量不变时 一单位预测变量的变化
#可以引起的响应变量 对数优势比 的变化
#因为这个对数优势比解释性差 我们可以对结果进行指数化 即
exp(coef(fit.reduced))
#(Intercept)           age  yearsmarried religiousness        rating 
#6.8952321     0.9653437     1.1058594     0.7196258     0.6304248 

#其它预测变量不变时 婚龄增加一年 优势比将乘以1.106

#评价预测变量对结果概率的影响
#即固定其它预测变量 仅研究感兴趣的某一预测变量变化后 结果的变化

#创造一个虚拟数据集 假定ge+yearsmarried+religiousness保持不变(此处设置为各种的均值)
#研究婚姻评分rating对婚外情概率的影响
testdata <- data.frame(rating=c(1,2,3,4,5),age=mean(Affairs$age),
                       yearsmarried=mean(Affairs$yearsmarried),
                       religiousness=mean(Affairs$religiousness))
testdata
#使用测试数据集预测响应的概率
testdata$prob <- predict(fit.reduced,newdata = testdata,type = "response")
testdata
#可见 随着婚姻评分rating从1到5 婚外情从0.53下降到0.15
#其它每一个预测变量都可以这样进行 研究其对结果概率的影响

#过度离势 即观测到的响应变量的方差大于期望的二项式分布的方差 
#过度离势或造成奇异的标准误检验和不精确的显著性检验

#方法1
deviance(fit.reduced)/df.residual(fit.reduced)
#如果值比1大得多 则可以存在过度离势

#方法2
fit <- glm(ynaffairs~age+yearsmarried+religiousness+rating,
          data = Affairs,family = binomial())

fit.od <- glm(ynaffairs~age+yearsmarried+religiousness+rating,
           data = Affairs,family = quasibinomial())#quasibinomial
pchisq(summary(fit.od)$dispersion*fit$df.residual,
       fit$df.residual,lower=F)
#p值不显著 表明不存在其过度离势

#扩展
#稳健logist回归 robus::glmRob()
#多项分布回归 mlogit::mlogit()
#序数logistic回归 rms::lrm()

#泊松分布
#使用robust包中的breslow数据集
library(robust)

data(breslow.dat,package="robust")
names(breslow.dat)
#本次只对以下四个变量感兴趣
summary(breslow.dat[c(6,7,8,10)])
#观察以下数据情况

opar <- par(no.readonly = TRUE)
par(mfrow=c(1,2))
attach(breslow.dat)
hist(sumY,breaks = 20,xlab = "seizure count",
     main = "Distribution of seizure")
boxplot(sumY~Trt,xlab = "Treatment",
        main = "Group Comparisons")
par(opar)

#泊松分布
fit<- glm(sumY~Base+Age+Trt,data = breslow.dat,family = poisson())
summary(fit)

#解释模型参数
coef(fit)
#(Intercept)         Base          Age Trtprogabide 
#1.94882593   0.02265174   0.02274013  -0.15270095 

#与logistic回归类似中 我们可以对结果进行指数化 即
exp(coef(fit))
#(Intercept)         Base          Age Trtprogabide 
#7.0204403    1.0229102    1.0230007    0.8583864 

#其它预测变量不变时 年龄增加一年 优势比将乘以1.023

#过度离势 即观测到的响应变量的方差大于泊松分布预测的方差 

#方法1
deviance(fit)/df.residual(fit)
#如果值比1大得多 则可以存在过度离势

#方法2 qcc包
library(qcc)
qcc.overdispersion.test(breslow.dat$sumY,type="poisson")
#p值表示有明显差异 存在过度离势
#通常使用family=quasipoisson替换family=poisson
fit.od <- glm(sumY~Base+Age+Trt,
           data = breslow.dat,family = quasipoisson())

summary(fit.od)
#可以发现 当考虑了过度离差后 Dispersion parameter for quasipoisson 
#family taken to be 11.76075 明显增大

#扩展
#时间段变化的泊松分布glm() offset选项
#零膨胀的泊松分布 pscl()包中的zeroinfl()函数
#稳健泊松分布 robust()包中的glmRob()函数可以拟合稳健广义线性模型 包括稳健泊松回归