Load data
library(vcd)
data("UCBAdmissions")
rearrange dimensions
UCB <- aperm(UCBAdmissions, c(2,1,3))
# marginal table, collapsing over Dept
(UCB2 <- margin.table(UCB, c(1,2)))
## Admit
## Gender Admitted Rejected
## Male 1198 1493
## Female 557 1278
Chisquare test
chisq.test(UCB2)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: UCB2
## X-squared = 91.61, df = 1, p-value < 2.2e-16
Fourfold plots
fourfold(UCB2)
# unstandardized version
fourfold(UCB2, std="ind.max")
3-way table, stratified by Dept
fourfold(UCB, mfrow=c(2,3))
test homogeneity of odds ratios over Dept
woolf_test(UCB)
##
## Woolf-test on Homogeneity of Odds Ratios (no 3-Way assoc.)
##
## data: UCB
## X-squared = 17.902, df = 5, p-value = 0.003072
calculate odds ratios
oddsratio(UCBAdmissions, log=FALSE)
## odds ratios for Admit and Gender by Dept
##
## A B C D E F
## 0.3492120 0.8025007 1.1330596 0.9212838 1.2216312 0.8278727
# ## plot log odds ratios
plot(oddsratio(UCBAdmissions),
xlab="Department",
ylab="Log Odds Ratio (Admit|Gender)")
IycgLS0tDQojJyB0aXRsZTogIlVDQkFkbWlzc2lvbnM6IGZvdXJmb2xkIGRpc3BsYXlzIGFuZCBvZGRzIHJhdGlvcyINCiMnIGF1dGhvcjogIk1pY2hhZWwgRnJpZW5kbHkiDQojJyBkYXRlOiAiYHIgZm9ybWF0KFN5cy5EYXRlKCkpYCINCiMnIG91dHB1dDoNCiMnICAgaHRtbF9kb2N1bWVudDoNCiMnICAgICB0aGVtZTogcmVhZGFibGUNCiMnICAgICBjb2RlX2Rvd25sb2FkOiB0cnVlDQojJyAtLS0NCg0KIysgZWNobz1GQUxTRQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KA0KICB3YXJuaW5nID0gRkFMU0UsICAgIyBhdm9pZCB3YXJuaW5ncyBhbmQgbWVzc2FnZXMgaW4gdGhlIG91dHB1dA0KICBtZXNzYWdlID0gRkFMU0UNCikNCg0KIycgIyMgTG9hZCBkYXRhDQpsaWJyYXJ5KHZjZCkNCmRhdGEoIlVDQkFkbWlzc2lvbnMiKQ0KDQojJyAjIyByZWFycmFuZ2UgZGltZW5zaW9ucyANClVDQiA8LSBhcGVybShVQ0JBZG1pc3Npb25zLCBjKDIsMSwzKSkNCiMgbWFyZ2luYWwgdGFibGUsIGNvbGxhcHNpbmcgb3ZlciBEZXB0DQooVUNCMiA8LSBtYXJnaW4udGFibGUoVUNCLCBjKDEsMikpKQ0KDQojJyMjICBDaGlzcXVhcmUgdGVzdA0KY2hpc3EudGVzdChVQ0IyKQ0KDQojJyAjIyBGb3VyZm9sZCBwbG90cw0KZm91cmZvbGQoVUNCMikNCiMgdW5zdGFuZGFyZGl6ZWQgdmVyc2lvbg0KZm91cmZvbGQoVUNCMiwgc3RkPSJpbmQubWF4IikNCg0KIycgIyMgMy13YXkgdGFibGUsIHN0cmF0aWZpZWQgYnkgRGVwdA0KZm91cmZvbGQoVUNCLCBtZnJvdz1jKDIsMykpDQoNCiMnICMjIHRlc3QgaG9tb2dlbmVpdHkgb2Ygb2RkcyByYXRpb3Mgb3ZlciBEZXB0DQp3b29sZl90ZXN0KFVDQikNCg0KIycgIyMgY2FsY3VsYXRlIG9kZHMgcmF0aW9zDQpvZGRzcmF0aW8oVUNCQWRtaXNzaW9ucywgbG9nPUZBTFNFKQ0KDQojICMjIHBsb3QgbG9nIG9kZHMgcmF0aW9zDQpwbG90KG9kZHNyYXRpbyhVQ0JBZG1pc3Npb25zKSwgDQogICAgIHhsYWI9IkRlcGFydG1lbnQiLCANCiAgICAgeWxhYj0iTG9nIE9kZHMgUmF0aW8gKEFkbWl0fEdlbmRlcikiKQ0K