51 lines
1.4 KiB
R
51 lines
1.4 KiB
R
## tests from David Firth 2004-Oct-13
|
|
|
|
pdf("polr.pdf")
|
|
|
|
library(MASS)
|
|
y <- structure(as.integer(c(1, 2, 3, 1, 2, 3)), .Label = c("1", "2", "3"),
|
|
class = c("ordered", "factor"))
|
|
Freq <- c(10, 0, 10, 10, 0, 10)
|
|
group <- structure(as.integer(c(1, 1, 1, 2, 2, 2)), .Label = c("1", "2"),
|
|
class = "factor")
|
|
|
|
temp <- polr(y ~ group, weights = Freq)
|
|
temp$convergence
|
|
temp
|
|
|
|
stopifnot(all(abs(coef(temp)) < 1e-4))
|
|
|
|
Freq <- c(1000000, 1, 1000000, 1000000, 1, 1000000)
|
|
temp2 <- polr(y ~ group, weights = Freq)
|
|
temp2
|
|
|
|
stopifnot(all(abs(coef(temp2)) < 1e-4))
|
|
|
|
## tests of rank-deficient model matrix
|
|
|
|
group <- factor(c(1, 1, 1, 2, 2, 2), levels=1:3)
|
|
polr(y ~ group, weights = Freq)
|
|
group <- factor(c(1, 1, 1, 3, 3, 3), levels=1:3)
|
|
polr(y ~ group, weights = Freq)
|
|
|
|
## profile on a single-coef model
|
|
## data from McCullagh JRSSB 1980
|
|
tonsils <- data.frame(carrier = factor(rep(c('yes', 'no'), each=3)),
|
|
size = ordered(rep(c(1,2,3),2)),
|
|
count = c(19,29,24,497,560,269))
|
|
m <- polr(size ~ carrier, data = tonsils, weights = count)
|
|
confint(m)
|
|
|
|
|
|
## refitting needs transformed starting values (Achim Zeileis Mar 2010)
|
|
load("BankWages.rda") # from AER
|
|
bw <- polr(job ~ education, data = BankWages)
|
|
summary(bw)
|
|
## failed due to incorrect restarting values
|
|
|
|
## missing drop = FALSE in profiling (Joris Meys, Sep 2012)
|
|
house.plr <- polr(Sat ~ Cont, weights = Freq, data = housing)
|
|
pr <- profile(house.plr)
|
|
plot(pr)
|
|
|