# Fit the proportional odds model, p.179, in McCullagh and Nelder (1989)
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))
pchisq(2*(logLik(fit3)-logLik(fit)),
df = length(coef(fit3))-length(coef(fit)), lower.tail = FALSE)
# A factor() version of fit ----------------------------------
# This is in long format (cf. wide format above)
nobs = round(fit@y * c(weights(fit, type = "prior")))
sumnobs = colSums(nobs) # apply(nobs, 2, sum)
pneumo.long = data.frame(symptoms = ordered(rep(rep(colnames(nobs),
nrow(nobs)),
times = c(t(nobs))),
levels = colnames(nobs)),
let = rep(rep(with(pneumo, let), each = ncol(nobs)),
times = c(t(nobs))))
with(pneumo.long, table(let, symptoms)) # check it; should be same as pneumo
(fit.long1 = vglm(symptoms ~ let, data = pneumo.long,
cumulative(parallel=TRUE, reverse=TRUE), trace=TRUE))
coef(fit.long1, matrix=TRUE) # Should be same as coef(fit, matrix=TRUE)
# Could try using mustart if fit.long1 failed to converge.
mymustart = matrix(sumnobs / sum(sumnobs),
nrow(pneumo.long), ncol(nobs), byrow = TRUE)
fit.long2 = vglm(symptoms ~ let,
fam = cumulative(parallel = TRUE, reverse = TRUE),
mustart = mymustart, data = pneumo.long, trace = TRUE)
coef(fit.long2, matrix = TRUE) # Should be same as coef(fit, matrix = TRUE)
Run the code above in your browser using DataLab