Exercise 4.2: Abortion data

library(vcdExtra)
data(Abortion, package="vcdExtra")
structable(Abortion)
##                         Status  Lo  Hi
## Sex    Support_Abortion               
## Female Yes                     171 138
##        No                       79 112
## Male   Yes                     152 167
##        No                      148 133

4.2a, b: Fourfold displays, stratified by status and sex

Permuting the table dimensions gives different views

Abortion2<-aperm(Abortion, c(1,3,2))
fourfold(Abortion2)

Abortion3<-aperm(Abortion, c(2,3,1))
fourfold(Abortion3)

4.2c: odds ratios

Sex by support for abortion, stratified by status

summary(oddsratio(Abortion2))
## 
## z test of coefficients:
## 
##    Estimate Std. Error z value Pr(>|z|)    
## Lo  0.74555    0.17844  4.1781 2.94e-05 ***
## Hi -0.01889    0.17228 -0.1096   0.9127    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Status by support for abortion, stratified by sex

summary(oddsratio(Abortion3)) 
## 
## z test of coefficients:
## 
##        Estimate Std. Error z value Pr(>|z|)   
## Female  0.56346    0.18623  3.0256 0.002481 **
## Male   -0.20098    0.16384 -1.2267 0.219941   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Summary

Support for abortion differs by sex and status. Among low status individuals, there is a strong tendency for women to support it compared to men. There is no association between sex and support among men.

Exercise 4.4: Hospital visits

\(\chi^2\) test and association

str(Hospital)
##  'table' num [1:3, 1:3] 43 6 9 16 11 18 3 10 16
##  - attr(*, "dimnames")=List of 2
##   ..$ Visit frequency: chr [1:3] "Regular" "Less than monthly" "Never"
##   ..$ Length of stay : chr [1:3] "2-9" "10-19" "20+"
chisq.test(Hospital)
## 
##  Pearson's Chi-squared test
## 
## data:  Hospital
## X-squared = 35.171, df = 4, p-value = 4.284e-07
assocstats(Hospital)
##                     X^2 df   P(> X^2)
## Likelihood Ratio 38.353  4 9.4755e-08
## Pearson          35.171  4 4.2842e-07
## 
## Phi-Coefficient   : NA 
## Contingency Coeff.: 0.459 
## Cramer's V        : 0.365

There is a strong association between visit frequency and length of stay

Association plot

The association plot shows that regular visits lead to shorter length of stay, never visiting to longer length of stay

assoc(Hospital, shade=TRUE)

CHMtest for ordinal variables

All CMH tests are significant, but the test for non-zero correlation has the largest \(\chi^2 /df\) and the smallest p-value.

CMHtest(Hospital)
## Cochran-Mantel-Haenszel Statistics for Visit frequency by Length of stay 
## 
##                  AltHypothesis  Chisq Df       Prob
## cor        Nonzero correlation 29.138  1 6.7393e-08
## rmeans  Row mean scores differ 34.391  2 3.4044e-08
## cmeans  Col mean scores differ 29.607  2 3.7233e-07
## general    General association 34.905  4 4.8596e-07

other plots

plot(Hospital, shade=TRUE)
tile(Hospital, shade=TRUE)

mosaic(Hospital, shade=TRUE)

spineplot(Hospital)

Exercise 4.6: Mammograms

str(Mammograms)
##  num [1:4, 1:4] 34 6 2 0 10 8 5 1 2 8 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ Reader2: chr [1:4] "Absent" "Minimal" "Moderate" "Severe"
##   ..$ Reader1: chr [1:4] "Absent" "Minimal" "Moderate" "Severe"
Mammograms
##           Reader1
## Reader2    Absent Minimal Moderate Severe
##   Absent       34      10        2      0
##   Minimal       6       8        8      2
##   Moderate      2       5        4     12
##   Severe        0       1        2     14

Kappa

The unweighted \(\kappa = 0.37\) is moderately strong, but the weighted versions, particularly using Fleiss-Cohen weights show very strong agreement, allowing for small steps of disagreement.

Kappa(Mammograms)
##             value     ASE      z  Pr(>|z|)
## Unweighted 0.3713 0.06033  6.154 7.560e-10
## Weighted   0.5964 0.04923 12.114 8.901e-34
Kappa(Mammograms, weights= "Fleiss-Cohen")
##             value     ASE      z  Pr(>|z|)
## Unweighted 0.3713 0.06033  6.154 7.560e-10
## Weighted   0.7641 0.03996 19.122 1.667e-81
confint(Kappa(Mammograms))
##             
## Kappa              lwr       upr
##   Unweighted 0.2530339 0.4895358
##   Weighted   0.4998809 0.6928576

Agreement plots

The agreement plots illustrate the strength of agreement. There is no tendency for the boxes to deviate systematically from the diagonal line, indicating that the two readers use the diagnostic categories more or less the same, except for the Severe category.

agreementplot(Mammograms, main="Unweighted", weights=1)

agreementplot(Mammograms, main="Weighted")

IycgLS0tDQojJyB0aXRsZTogIkFzc2lnbm1lbnQgMjogU29tZSBzb2x1dGlvbnMiDQojJyBhdXRob3I6ICJNaWNoYWVsIEZyaWVuZGx5Ig0KIycgZGF0ZTogImByIGZvcm1hdChTeXMuRGF0ZSgpKWAiDQojJyBvdXRwdXQ6DQojJyAgIGh0bWxfZG9jdW1lbnQ6DQojJyAgICAgdGhlbWU6IHJlYWRhYmxlDQojJyAgICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KIycgLS0tDQoNCiMrIGVjaG89RkFMU0UNCmtuaXRyOjpvcHRzX2NodW5rJHNldCgNCiAgd2FybmluZyA9IEZBTFNFLCAgICMgYXZvaWQgd2FybmluZ3MgYW5kIG1lc3NhZ2VzIGluIHRoZSBvdXRwdXQNCiAgbWVzc2FnZSA9IEZBTFNFDQopDQoNCiMnICMjIEV4ZXJjaXNlIDQuMjogQWJvcnRpb24gZGF0YQ0KDQpsaWJyYXJ5KHZjZEV4dHJhKQ0KZGF0YShBYm9ydGlvbiwgcGFja2FnZT0idmNkRXh0cmEiKQ0Kc3RydWN0YWJsZShBYm9ydGlvbikNCg0KIycgIyMjIDQuMmEsIGI6IEZvdXJmb2xkIGRpc3BsYXlzLCBzdHJhdGlmaWVkIGJ5IHN0YXR1cyBhbmQgc2V4DQojJyBQZXJtdXRpbmcgdGhlIHRhYmxlIGRpbWVuc2lvbnMgZ2l2ZXMgZGlmZmVyZW50IHZpZXdzDQpBYm9ydGlvbjI8LWFwZXJtKEFib3J0aW9uLCBjKDEsMywyKSkNCmZvdXJmb2xkKEFib3J0aW9uMikNCg0KQWJvcnRpb24zPC1hcGVybShBYm9ydGlvbiwgYygyLDMsMSkpDQpmb3VyZm9sZChBYm9ydGlvbjMpDQoNCiMnICMjIyA0LjJjOiBvZGRzIHJhdGlvcw0KIycgU2V4IGJ5IHN1cHBvcnQgZm9yIGFib3J0aW9uLCBzdHJhdGlmaWVkIGJ5IHN0YXR1cw0Kc3VtbWFyeShvZGRzcmF0aW8oQWJvcnRpb24yKSkNCg0KIycgU3RhdHVzIGJ5IHN1cHBvcnQgZm9yIGFib3J0aW9uLCBzdHJhdGlmaWVkIGJ5IHNleA0Kc3VtbWFyeShvZGRzcmF0aW8oQWJvcnRpb24zKSkgDQoNCiMnICMjIyBTdW1tYXJ5DQojJyBTdXBwb3J0IGZvciBhYm9ydGlvbiBkaWZmZXJzIGJ5IHNleCBhbmQgc3RhdHVzLiBBbW9uZyBsb3cgc3RhdHVzIGluZGl2aWR1YWxzLA0KIycgdGhlcmUgaXMgYSBzdHJvbmcgdGVuZGVuY3kgZm9yIHdvbWVuIHRvIHN1cHBvcnQgaXQgY29tcGFyZWQgdG8gbWVuLiBUaGVyZQ0KIycgaXMgbm8gYXNzb2NpYXRpb24gYmV0d2VlbiBzZXggYW5kIHN1cHBvcnQgYW1vbmcgbWVuLg0KIycgDQojJyANCiMnICMjIEV4ZXJjaXNlIDQuNDogSG9zcGl0YWwgdmlzaXRzDQojJyAkXGNoaV4yJCB0ZXN0IGFuZCBhc3NvY2lhdGlvbg0Kc3RyKEhvc3BpdGFsKQ0KY2hpc3EudGVzdChIb3NwaXRhbCkNCmFzc29jc3RhdHMoSG9zcGl0YWwpDQoNCiMnIFRoZXJlIGlzIGEgc3Ryb25nIGFzc29jaWF0aW9uIGJldHdlZW4gdmlzaXQgZnJlcXVlbmN5IGFuZCBsZW5ndGggb2Ygc3RheQ0KIycNCiMnICMjIyBBc3NvY2lhdGlvbiBwbG90DQojJyBUaGUgYXNzb2NpYXRpb24gcGxvdCBzaG93cyB0aGF0IHJlZ3VsYXIgdmlzaXRzIGxlYWQgdG8gc2hvcnRlciBsZW5ndGggb2Ygc3RheSwNCiMnIG5ldmVyIHZpc2l0aW5nIHRvIGxvbmdlciBsZW5ndGggb2Ygc3RheQ0KYXNzb2MoSG9zcGl0YWwsIHNoYWRlPVRSVUUpDQoNCiMnICMjIyBDSE10ZXN0IGZvciBvcmRpbmFsIHZhcmlhYmxlcw0KIycgQWxsIENNSCB0ZXN0cyBhcmUgc2lnbmlmaWNhbnQsIGJ1dCB0aGUgdGVzdCBmb3Igbm9uLXplcm8gY29ycmVsYXRpb24gaGFzIHRoZSBsYXJnZXN0DQojJyAkXGNoaV4yIC9kZiQgYW5kIHRoZSBzbWFsbGVzdCBwLXZhbHVlLg0KQ01IdGVzdChIb3NwaXRhbCkNCg0KIycgIyMjIG90aGVyIHBsb3RzDQpwbG90KEhvc3BpdGFsLCBzaGFkZT1UUlVFKQ0KdGlsZShIb3NwaXRhbCwgc2hhZGU9VFJVRSkNCm1vc2FpYyhIb3NwaXRhbCwgc2hhZGU9VFJVRSkNCnNwaW5lcGxvdChIb3NwaXRhbCkNCg0KIycgIyMgRXhlcmNpc2UgNC42OiBNYW1tb2dyYW1zDQpzdHIoTWFtbW9ncmFtcykNCk1hbW1vZ3JhbXMNCg0KIycgIyMjIEthcHBhDQojJyBUaGUgdW53ZWlnaHRlZCAkXGthcHBhID0gMC4zNyQgaXMgbW9kZXJhdGVseSBzdHJvbmcsIGJ1dCB0aGUgd2VpZ2h0ZWQgdmVyc2lvbnMsDQojJyBwYXJ0aWN1bGFybHkgdXNpbmcgRmxlaXNzLUNvaGVuIHdlaWdodHMgc2hvdyB2ZXJ5IHN0cm9uZyBhZ3JlZW1lbnQsIGFsbG93aW5nDQojJyBmb3Igc21hbGwgc3RlcHMgb2YgZGlzYWdyZWVtZW50Lg0KS2FwcGEoTWFtbW9ncmFtcykNCkthcHBhKE1hbW1vZ3JhbXMsIHdlaWdodHM9ICJGbGVpc3MtQ29oZW4iKQ0KY29uZmludChLYXBwYShNYW1tb2dyYW1zKSkNCg0KIycgIyMjIEFncmVlbWVudCBwbG90cw0KIycgVGhlIGFncmVlbWVudCBwbG90cyBpbGx1c3RyYXRlIHRoZSBzdHJlbmd0aCBvZiBhZ3JlZW1lbnQuIFRoZXJlIGlzIG5vIHRlbmRlbmN5IGZvciB0aGUNCiMnIGJveGVzIHRvIGRldmlhdGUgc3lzdGVtYXRpY2FsbHkgZnJvbSB0aGUgZGlhZ29uYWwgbGluZSwgaW5kaWNhdGluZyB0aGF0IHRoZSB0d28gcmVhZGVycw0KIycgdXNlIHRoZSBkaWFnbm9zdGljIGNhdGVnb3JpZXMgbW9yZSBvciBsZXNzIHRoZSBzYW1lLCBleGNlcHQgZm9yIHRoZSBgU2V2ZXJlYCBjYXRlZ29yeS4NCiMnIA0KYWdyZWVtZW50cGxvdChNYW1tb2dyYW1zLCBtYWluPSJVbndlaWdodGVkIiwgd2VpZ2h0cz0xKQ0KYWdyZWVtZW50cGxvdChNYW1tb2dyYW1zLCBtYWluPSJXZWlnaHRlZCIpDQoNCg0KDQoNCg0KDQo=