set.seed(1)
summary(backPain)
### Re-express as count data
backPainLong <- expandCategorical(backPain, "pain")
### Fit models described in Table 5 of Anderson (1984)
### Logistic family models
noRelationship <- gnm(count ~ pain, eliminate = id,
family = "poisson", data = backPainLong)
## stereotype model
oneDimensional <- update(noRelationship,
~ . + Mult(pain, x1 + x2 + x3))
## multinomial logistic
threeDimensional <- update(noRelationship, ~ . + pain:(x1 + x2 + x3))
### Models to determine distinguishability in stereotype model
## constrain scale of category-specific multipliers
oneDimensional <- update(noRelationship,
~ . + Mult(pain, offset(x1) + x2 + x3))
## obtain identifiable contrasts; id possibly indistinguishable slopes
getContrasts(oneDimensional, pickCoef(oneDimensional, "[.]pain"))
if (FALSE) {
## (this part not needed for package testing)
## fit simpler models and compare
.pain <- backPainLong$pain
levels(.pain)[2:3] <- paste(levels(.pain)[2:3], collapse = " | ")
fiveGroups <- update(noRelationship,
~ . + Mult(.pain, x1 + x2 + x3))
levels(.pain)[4:5] <- paste(levels(.pain)[4:5], collapse = " | ")
fourGroups <- update(fiveGroups)
levels(.pain)[2:3] <- paste(levels(.pain)[2:3], collapse = " | ")
threeGroups <- update(fourGroups)
### Grouped continuous model, aka proportional odds model
library(MASS)
sixCategories <- polr(pain ~ x1 + x2 + x3, data = backPain)
### Obtain number of parameters and log-likelihoods for equivalent
### multinomial models as presented in Anderson (1984)
logLikMultinom <- function(model, size){
object <- get(model)
if (inherits(object, "gnm")) {
l <- sum(object$y * log(object$fitted/size))
c(nParameters = object$rank - nlevels(object$eliminate),
logLikelihood = l)
}
else
c(nParameters = object$edf, logLikelihood = -deviance(object)/2)
}
size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id]
models <- c("threeDimensional", "oneDimensional", "noRelationship",
"fiveGroups", "fourGroups", "threeGroups", "sixCategories")
t(sapply(models, logLikMultinom, size))
}
Run the code above in your browser using DataLab