#-*- S -*-

# Chapter 7   Generalized Linear Models

library(MASS)
postscript(file="ch07.ps", width=8, height=6, pointsize=9)
options(contrasts=c("contr.treatment", "contr.poly"))


# 7.2  Binomial data

ldose <- rep(0:5, 2)
numdead <- c(1, 4, 9, 13, 18, 20, 0, 2, 6, 10, 12, 16)
sex <- factor(rep(c("M", "F"), c(6, 6)))
SF <- cbind(numdead, numalive=20-numdead)
budworm.lg <- glm(SF ~ sex*ldose, family=binomial)
summary(budworm.lg)

plot(c(1,32), c(0,1), type="n", xlab="dose",
   ylab="prob", log="x")
text(2^ldose, numdead/20,as.character(sex))
ld <- seq(0, 5, 0.1)
lines(2^ld, predict(budworm.lg, data.frame(ldose=ld, 
   sex=factor(rep("M", length(ld)), levels=levels(sex))),
   type="response"))
lines(2^ld, predict(budworm.lg, data.frame(ldose=ld, 
   sex=factor(rep("F", length(ld)), levels=levels(sex))),
   type="response"))

budworm.lgA <- update(budworm.lg, . ~ sex*I(ldose-3))
summary(budworm.lgA)$coefficients
anova(update(budworm.lg, . ~ . + sex*I(ldose^2)), test="Chisq")

budworm.lg0 <- glm(SF ~ sex + ldose - 1, family=binomial)
summary(budworm.lg0)$coefficients

dose.p(budworm.lg0, cf = c(1,3), p = 1:3/4)
dose.p(update(budworm.lg0, family=binomial(link=probit)),
       cf = c(1,3), p = 1:3/4)


options(contrasts=c("contr.treatment", "contr.poly"))
data(birthwt)
attach(birthwt)
race <- factor(race, labels=c("white", "black", "other"))
table(ptl)
ptd <- factor(ptl > 0)
table(ftv)
ftv <- factor(ftv)
levels(ftv)[-(1:2)] <- "2+"
table(ftv)  # as a check
bwt <- data.frame(low=factor(low), age, lwt, race,
    smoke=(smoke>0), ptd, ht=(ht>0), ui=(ui>0), ftv)
detach(); rm(race, ptd, ftv)

birthwt.glm <- glm(low ~ ., family=binomial, data=bwt)
summary(birthwt.glm, correlation=F)
birthwt.step <- step(birthwt.glm, trace=F)
birthwt.step$anova
birthwt.step2 <- step(birthwt.glm, ~ .^2 + I(scale(age)^2)
    + I(scale(lwt)^2), trace=F)
birthwt.step2$anova
summary(birthwt.step2, corr=F)$coef
table(bwt$low, predict(birthwt.step2) > 0)

# 7.3  Poisson models

detg <- cbind(expand.grid(Brand=c("X","M"),
  Temp=c("Low","High"), M.user=c("N","Y"),
  Soft=c("Hard","Medium","Soft")),
  Fr= c(68,42,42,30,37,52,24,43,  66,50,33,23,47,55,23,47,
        63,53,29,27,57,49,19,29))
detg$Soft <- ordered(detg$Soft,
  levels=c("Soft","Medium","Hard"))

detg.m0 <- glm(Fr ~ M.user*Temp*Soft + Brand,
                 family=poisson, data=detg)
detg.m0
detg.step <- step(detg.m0, list(lower=formula(detg.m0),
     upper= ~ .^3), scale=1, trace=F)
detg.step$anova
detg.mod <- glm(terms(Fr ~ M.user*Temp*Soft +
                     Brand*M.user*Temp, keep.order=T),
                     family=poisson, data=detg)
summary(detg.mod, correlation=F)

attach(detg)
detg.tab <- table(M.user, Temp, Soft, Brand)
names(dimnames(detg.tab)) <- c("M.user","Temp","Soft","Brand")
detg.tab[cbind(M.user, Temp, Soft, Brand)] <- Fr
detg.ips <- loglin(detg.tab,  margin=list(c(1,2,3), c(1,2,4)) )
c(detg.ips$df, detg.ips$lrt, detg.ips$pearson)
detach()

attach(detg)
deterg <- cbind(detg[Brand=="X", -1],
      M = detg[Brand=="M","Fr"])
detach()
names(deterg)[4] <- "X"
detg.lg <- glm(cbind(M, X) ~ M.user*Temp,
     family=binomial, data=deterg)
summary(detg.lg, correlation=F)
cbind(deterg, p=predict(detg.lg, type="response"))


# 7.4  A negative binomial family

data(quine)
glm(Days ~ .^4, family=poisson, data=quine)
quine.nb <- glm(Days ~ .^4, family=neg.bin(2), data=quine)
quine.nb0 <- update(quine.nb, . ~ Sex/(Age + Eth*Lrn))
anova(quine.nb0, quine.nb, test="Chi")

quine.nb1 <- glm.nb(Days ~ Sex/(Age + Eth*Lrn), data=quine)
quine.nb2 <- update(quine.nb1, . ~ . + Sex:Age:Lrn)
quine.nb3 <- update(quine.nb2, Days ~ .^4)
anova(quine.nb1, quine.nb2, quine.nb3)
c(theta=quine.nb2$theta, SE=quine.nb2$SE)

par(mfrow=c(2,2), pty="m")
rs <- resid(quine.nb2, type="deviance")
plot(predict(quine.nb2), rs, xlab="Linear predictors",
    ylab="Deviance residuals")
abline(h=0, lty=2)
qqnorm(rs, ylab="Deviance residuals")
qqline(rs)
par(mfrow=c(1,1))


# =========================================

# Chapter 7 Complements


# 7.3  Poisson models

detg.ll <- loglm(Fr ~ Brand*M.user*Temp + M.user*Temp*Soft, data=detg)
detg.ll

data(minn38)
sapply(minn38, function(x) length(levels(x)))
minn38a <- array(0, c(3,4,7,2), lapply(minn38[, -5], levels))
minn38a[data.matrix(minn38[, -5])] <- minn38$f
minn38.fm <- loglm(~ 1 + 2 + 3 + 4, minn38a)
minn38.fm1 <- update(minn38.fm, ~.^2)
minn38.fm2 <- update(minn38.fm, ~.^3)

minn38.fm <- loglm(~ hs + phs + fol + sex, minn38a)
minn38.fm
summary(minn38.fm2, fitted=T)
anova(minn38.fm, minn38.fm1, minn38.fm2)

if(F) {
attach(Cars93)
levels(Type)
levels(Origin)
detach()  
form <- ~ Type + Origin
loglm(form, crosstabs(form, Cars93))
}

minn38.fm <- loglm(f ~ ., minn38, fit = T)
minn38.fm

quine.loglm <- loglm(Days ~ .^3, quine)
quine.glm <- glm(Days ~ .^3, poisson, quine)
c(loglm = deviance(quine.loglm), glm = deviance(quine.glm))
c(loglm = quine.loglm$df, glm = quine.glm$df.resid)


# 7.5  Gamma models

clotting <- data.frame(
    u = c(5,10,15,20,30,40,60,80,100),
    lot1 = c(118,58,42,35,27,25,21,19,18),
    lot2 = c(69,35,26,21,18,16,13,12,12))
clot1 <- glm(lot1 ~ log(u), data=clotting, family=Gamma)
summary(clot1, cor=F)
clot1$deviance/clot1$df.residual
gamma.dispersion(clot1)
clot2 <- glm(lot2 ~ log(u), data=clotting, family=Gamma)
summary(clot2, cor=F)
clot2$deviance/clot2$df.residual
gamma.dispersion(clot2)

data(quine)
gm <- glm(Days + 0.1 ~ Age*Eth*Sex*Lrn, 
            quasi(link=log, variance=mu^2), data=quine)
summary(gm, cor=F)
gamma.shape(gm, verbose=T)
summary(gm, dispersion = gamma.dispersion(gm), cor=F)
gm$deviance/gm$df.residual
gamma.dispersion(gm)

# End of ch07
