# Fit the proportional odds model, p.179, in McCullagh and Nelder (1989)
data(pneumo)
pneumo = transform(pneumo, let=log(exposure.time))
(fit = vglm(cbind(normal, mild, severe) ~ let,
cumulative(parallel=TRUE, reverse=TRUE), pneumo))
fit@y # Sample proportions
weights(fit, type="prior") # Number of observations
coef(fit, matrix=TRUE)
constraints(fit) # Constraint matrices
# Check that the model is linear in let ----------------------
fit2 = vgam(cbind(normal, mild, severe) ~ s(let, df=2),
cumulative(reverse=TRUE), pneumo)
plot(fit2, se=TRUE, overlay=TRUE, lcol=1:2, scol=1:2)
# Check the proportional odds assumption with a LRT ----------
(fit3 = vglm(cbind(normal, mild, severe) ~ let,
cumulative(parallel=FALSE, reverse=TRUE), pneumo))
1 - pchisq(2*(logLik(fit3)-logLik(fit)),
df=length(coef(fit3))-length(coef(fit)))
# A factor() version of fit ----------------------------------
nobs = round(fit@y * c(weights(fit, type="prior")))
sumnobs = apply(nobs, 2, sum)
mydat = data.frame(
response = ordered(c(rep("normal", times=sumnobs["normal"]),
rep("mild", times=sumnobs["mild"]),
rep("severe", times=sumnobs["severe"])),
levels = c("normal","mild","severe")),
LET = c(with(pneumo, rep(let, times=nobs[,"normal"])),
with(pneumo, rep(let, times=nobs[,"mild"])),
with(pneumo, rep(let, times=nobs[,"severe"]))))
(fit4 = vglm(response ~ LET, data=mydat,
cumulative(parallel=TRUE, reverse=TRUE), trace=TRUE))
Run the code above in your browser using DataLab