## artificial example
set.seed(1)
x <- matrix(rpois(5 * 3, 7), ncol = 5, nrow = 3)
dimnames(x) <- list(Row=head(letters, 3), Col=tail(letters, 5))
x_lor <- loddsratio(x)
coef(x_lor)
x_lor
confint(x_lor)
if(require("lmtest")) coeftest(x_lor)
## 2 x 2 x k cases
#data(CoalMiners, package="vcd")
lor.CM <- loddsratio(CoalMiners)
lor.CM
coef(lor.CM)
confint(lor.CM)
confint(lor.CM, log=FALSE)
# odds ratio plot
lor.CM.df <- as.data.frame(lor.CM)
lor.CM.df <- within(lor.CM.df,
{lower<-LOR-ASE
upper<-LOR+ASE}
)
range <- c(min(lor.CM.df$lower), max(lor.CM.df$upper))
with(lor.CM.df, {
plot(LOR ~ as.numeric(Age), type='b', pch=16, xaxt='n',
ylim=range,
xlab="Age", ylab="Log odds ratio: Wheeze x Breathlessness",
main="CoalMiners data: Log odds ratio plot")
axis(side=1, at=as.numeric(Age), labels=Age)
segments(as.numeric(Age), lower, as.numeric(Age), upper)
}
)
# fit linear models using WLS
abline(lm(LOR ~ as.numeric(Age), weights=1/ASE^2, data=lor.CM.df), col="blue")
age <- seq(25, 60, by = 5)
qmod <- lm(LOR ~ poly(age,2), weights=1/ASE^2, data=lor.CM.df)
lines(fitted(qmod), col = "red", lwd=2)
## 2 x k x 2
lor.Emp <-loddsratio(Employment)
lor.Emp
confint(lor.Emp)
# visualize the log odds ratios
lor.Emp.a <- as.array(lor.Emp)
matplot(lor.Emp.a, type='b', xaxt='n', pch=15:16, cex=1.5,
ylab='log odds ratio: Employment Status x Length',
xlab='Employment Length',
xlim=c(0.2, 5),
main="Employment status data")
abline(h=0, col='gray')
axis(side=1, at=1:5, labels=rownames(lor.Emp.a))
text(0.3, lor.Emp.a[1,], colnames(lor.Emp.a), pos=4, col=1:2)
text(0.5, max(lor.Emp.a[1,])+.1, "Layoff cause")
## R x C case
#data(Hauser79, package="vcdExtra")
hauser.tab <- xtabs(Freq ~ Father+Son, data=Hauser79)
(lor.hauser <- loddsratio(hauser.tab))
confint(lor.hauser)
# odds ratio plot
op <- par(xpd=TRUE)
matplot(as.matrix(lor.hauser), type='b', ylab='log odds ratio',
xlab="Son's status comparisons", xaxt='n', xlim=c(1,4.5), ylim=c(-.5,3),
main="Hauser79 data")
abline(h=0, col='gray')
axis(side=1, at=1:4, labels=colnames(lor.hauser))
text(4, as.matrix(lor.hauser)[4,], rownames(lor.hauser), pos=4, col=1:4)
text(4, 3, "Father's status")
par(op)
## 4 way tables
data(Punishment, package="vcd")
punish <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment)
mosaic(~ age + education + memory + attitude, data = punish, keep = FALSE,
gp = gpar(fill = grey.colors(2)), spacing = spacing_highlighting,
rep = c(attitude = FALSE))
lor.pun <- loddsratio(punish)
lor.pun
confint(lor.pun)
if(require("lmtest")) coeftest(lor.pun)
# visualize the log odds ratios, by education
lor.pun.a <- as.array(lor.pun)
matplot(lor.pun.a, type='b', xaxt='n', pch=15:17, cex=1.5,
ylab='log odds ratio: Attitude x Memory',
xlab='Age', xlim=c(0.5, 3), ylim=c(-2, 1),
main="Attitudes toward corporal punishment")
abline(h=0, col='gray')
axis(side=1, at=1:3, labels=rownames(lor.pun.a))
text(0.5, lor.pun.a[1,], colnames(lor.pun.a), pos=4, col=1:3)
text(0.6, max(lor.pun.a[1,])+.2, "Education")
# visualize the log odds ratios, by age
matplot(t(lor.pun.a), type='b', xaxt='n', pch=15:17, cex=1.5,
ylab='log odds ratio: Attitude x Memory',
xlab='Education', xlim=c(0.5, 3), ylim=c(-2, 1),
main="Attitudes toward corporal punishment")
abline(h=0, col='gray')
axis(side=1, at=1:3, labels=colnames(lor.pun.a))
text(0.5, lor.pun.a[,1], rownames(lor.pun.a), pos=4, col=1:3)
text(0.6, max(lor.pun.a[,1])+.2, "Age")
# fit linear model using WLS
lor.pun.df <- as.data.frame(lor.pun)
pun.mod1 <- lm(LOR ~ as.numeric(age) * as.numeric(education), data=lor.pun.df, weights=1/ASE^2)
anova(pun.mod1)
Run the code above in your browser using DataLab