zoukankan      html  css  js  c++  java
  • 吴裕雄--天生自然 R语言开发学习:广义线性模型

    #----------------------------------------------#
    # R in Action (2nd ed): Chapter 13             #
    # Generalized linear models                    #
    # requires packages AER, robust, gcc           #
    # install.packages(c("AER", "robust", "gcc"))  #
    #----------------------------------------------#
    
    
    ## Logistic Regression
    
    # get summary statistics
    data(Affairs, package="AER")
    summary(Affairs)
    table(Affairs$affairs)
    
    # create binary outcome variable
    Affairs$ynaffair[Affairs$affairs > 0] <- 1
    Affairs$ynaffair[Affairs$affairs == 0] <- 0
    Affairs$ynaffair <- factor(Affairs$ynaffair, 
                               levels=c(0,1),
                               labels=c("No","Yes"))
    table(Affairs$ynaffair)
    
    # fit full model
    fit.full <- glm(ynaffair ~ gender + age + yearsmarried + children + 
                      religiousness + education + occupation +rating,
                    data=Affairs,family=binomial())
    summary(fit.full)
    
    # fit reduced model
    fit.reduced <- glm(ynaffair ~ age + yearsmarried + religiousness + 
                         rating, data=Affairs, family=binomial())
    summary(fit.reduced)
    
    # compare models
    anova(fit.reduced, fit.full, test="Chisq")
    
    # interpret coefficients
    coef(fit.reduced)
    exp(coef(fit.reduced))
    
    # calculate probability of extramariatal affair by marital ratings
    testdata <- data.frame(rating = c(1, 2, 3, 4, 5),
                           age = mean(Affairs$age),
                           yearsmarried = mean(Affairs$yearsmarried),
                           religiousness = mean(Affairs$religiousness))
    testdata$prob <- predict(fit.reduced, newdata=testdata, type="response")
    testdata
    
    # calculate probabilites of extramariatal affair by age
    testdata <- data.frame(rating = mean(Affairs$rating),
                           age = seq(17, 57, 10), 
                           yearsmarried = mean(Affairs$yearsmarried),
                           religiousness = mean(Affairs$religiousness))
    testdata$prob <- predict(fit.reduced, newdata=testdata, type="response")
    testdata
    
    # evaluate overdispersion
    fit <- glm(ynaffair ~ age + yearsmarried + religiousness +
                 rating, family = binomial(), data = Affairs)
    fit.od <- glm(ynaffair ~ age + yearsmarried + religiousness +
                    rating, family = quasibinomial(), data = Affairs)
    pchisq(summary(fit.od)$dispersion * fit$df.residual,  
           fit$df.residual, lower = F)
    
    
    ## Poisson Regression
    
    # look at dataset
    data(breslow.dat, package="robust")
    names(breslow.dat)
    summary(breslow.dat[c(6, 7, 8, 10)])
    
    # plot distribution of post-treatment seizure counts
    opar <- par(no.readonly=TRUE)
    par(mfrow=c(1, 2))
    attach(breslow.dat)
    hist(sumY, breaks=20, xlab="Seizure Count", 
         main="Distribution of Seizures")
    boxplot(sumY ~ Trt, xlab="Treatment", main="Group Comparisons")
    par(opar)
    
    # fit regression
    fit <- glm(sumY ~ Base + Age + Trt, data=breslow.dat, family=poisson())
    summary(fit)
    
    # interpret model parameters
    coef(fit)
    exp(coef(fit))
    
    # evaluate overdispersion
    deviance(fit)/df.residual(fit)
    library(qcc)
    qcc.overdispersion.test(breslow.dat$sumY, type="poisson")
    
    # fit model with quasipoisson
    fit.od <- glm(sumY ~ Base + Age + Trt, data=breslow.dat,
                  family=quasipoisson())
    summary(fit.od)
  • 相关阅读:
    天梯赛练习 L3-011 直捣黄龙 (30分) dijkstra + dfs
    PAT甲级练习 1087 All Roads Lead to Rome (30分) 字符串hash + dijkstra
    天梯赛练习 L3-010 是否完全二叉搜索树 (30分) 数组建树模拟
    天梯赛练习 L3-008 喊山 (30分) bfs搜索
    天梯赛练习 L3-007 天梯地图 (30分) Dijkstra
    1018 Public Bike Management (30分) PAT甲级真题 dijkstra + dfs
    PAT天梯赛练习 L3-004 肿瘤诊断 (30分) 三维BFS
    课堂实验(计算1!+2!+...+100!)
    39页作业第7题
    39页作业(还款年限—月还款额表)
  • 原文地址:https://www.cnblogs.com/tszr/p/11176003.html
Copyright © 2011-2022 走看看