#Problem_13_8_25.r
#
# Custom function implementing chisqtest
fcn.chisqtest<-function(tableA){
cat("\n Two-Way Table: \n")
print(tableA)
n.total=sum(as.vector(tableA))
cat("\n Total Counts in Table: ", n.total,"\n")
# Compute marginal probabilities of
# TattooStatus and of HepCStatus
probs.TattooStatus=rowSums(tableA)/n.total
probs.HepCStatus=colSums(tableA)/n.total
cat("\n MLEs of row level probabilities\n")
print(probs.TattooStatus)
cat("\n MLEs of column level probabilities\n")
print(probs.HepCStatus)
# Compute table of fitted cell probabilities and
# expected counts assuming independence of two factors
tableA.fittedprobs=as.matrix(probs.TattooStatus)%*% t(
as.matrix(probs.HepCStatus) )
cat("\n Fitted cell probabilities assuming independence\n")
print(tableA.fittedprobs)
tableA.expected=n.total* tableA.fittedprobs
cat("\n Expected Counts assuming independence \n")
print(tableA.expected)
# Compute standardized residuals fitted table
tableA.chisqresiduals=((tableA - tableA.expected))/sqrt(tableA.expected)
cat("\n Table of Chi-Square Residuals by cell\n")
print(tableA.chisqresiduals)
# Compute table of chi-square test statistic contributions
tableA.chisqterms=((tableA - tableA.expected)^2)/tableA.expected
cat("\n Table of Chi-Square statistic terms by cell\n")
print(tableA.chisqterms)
tableA.chisqStatistic=sum(as.vector(tableA.chisqterms))
cat("\n Chi-Square Statistic: ",tableA.chisqStatistic,"\n")
df.tableA=(nrow(tableA)-1)*(ncol(tableA)-1)
cat("\n degrees of freedom: ", df.tableA, "\n")
tableA.chisqStatistic.pvalue=1-
pchisq(tableA.chisqStatistic, df=df.tableA)
cat("\n P-Value : ", tableA.chisqStatistic.pvalue, "\n\n")
}
###############
# 1. Problem 25: Physicians Health Study Tattoo/HepC Two-Way Table ----
tableD=data.frame(
Asprin=rbind(
MCIFatal=10,
MCINonFatal=129,
StrokeFatal=9,
StrokeNonFatal=110),
Placebo=rbind(
MCIFatal=26,
MCINonFatal=213,
StrokeFatal=6,
StrokeNonFatal=92)
)
tableD.colSums=colSums(tableD)
tableD.1<-rbind(tableD,
None=((tableD.colSums*-1) +c(11037, 11034)))
# (a). Test 1
# Chisquare test of homogenity -- rates are same
# for Aspirin population and Placebo population
fcn.chisqtest(tableD.1)
##
## Two-Way Table:
## Asprin Placebo
## MCIFatal 10 26
## MCINonFatal 129 213
## StrokeFatal 9 6
## StrokeNonFatal 110 92
## None 10779 10697
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## MCIFatal MCINonFatal StrokeFatal StrokeNonFatal None
## 0.0016310996 0.0154954465 0.0006796248 0.0091522813 0.9730415477
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## MCIFatal 0.0008156607 0.0008154390
## MCINonFatal 0.0077487764 0.0077466701
## StrokeFatal 0.0003398586 0.0003397662
## StrokeNonFatal 0.0045767626 0.0045755186
## None 0.4865869042 0.4864546435
##
## Expected Counts assuming independence
## Asprin Placebo
## MCIFatal 18.002447 17.997553
## MCINonFatal 171.023243 170.976757
## StrokeFatal 7.501019 7.498981
## StrokeNonFatal 101.013728 100.986272
## None 10739.459562 10736.540438
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## MCIFatal -1.8860666 1.8863230
## MCINonFatal -3.2133793 3.2138162
## StrokeFatal 0.5473131 -0.5473875
## StrokeNonFatal 0.8941067 -0.8942282
## None 0.3815489 -0.3816008
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## MCIFatal 3.5572472 3.5582143
## MCINonFatal 10.3258068 10.3286142
## StrokeFatal 0.2995516 0.2996331
## StrokeNonFatal 0.7994268 0.7996441
## None 0.1455796 0.1456192
##
## Chi-Square Statistic: 30.25934
##
## degrees of freedom: 4
##
## P-Value : 4.33405e-06
# Results significant, with MCIFatal and MCINonFatal significantly
# lower for Aspirin versus Placebo (see the chisq residuals)
# (a). Test 2
# Analyse total incidence of myocardial infarction
tableD.2=rbind(
MCITotal=colSums(tableD.1[1:2,]),
Other=colSums(tableD.1[3:5,]))
print(tableD.2)
## Asprin Placebo
## MCITotal 139 239
## Other 10898 10795
fcn.chisqtest(tableD.2)
##
## Two-Way Table:
## Asprin Placebo
## MCITotal 139 239
## Other 10898 10795
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## MCITotal Other
## 0.01712655 0.98287345
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## MCITotal 0.008564437 0.008562109
## Other 0.491503525 0.491369928
##
## Expected Counts assuming independence
## Asprin Placebo
## MCITotal 189.0257 188.9743
## Other 10847.9743 10845.0257
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## MCITotal -3.6385862 3.6390808
## Other 0.4803068 -0.4803721
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## MCITotal 13.2393097 13.2429093
## Other 0.2306947 0.2307574
##
## Chi-Square Statistic: 26.94367
##
## degrees of freedom: 1
##
## P-Value : 2.09472e-07
# Total incidence of MCI is significantly reduced by aspirin
# (a). Test 3
# Analyse incidence of fatal and nonfatal
tableD.3=rbind(
FatalNonFatal=colSums(tableD.1[c(1,2,3,4),]),
Other=colSums(tableD.1[c(5),]))
fcn.chisqtest(tableD.3)
##
## Two-Way Table:
## Asprin Placebo
## FatalNonFatal 258 337
## Other 10779 10697
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## FatalNonFatal Other
## 0.02695845 0.97304155
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## FatalNonFatal 0.01348106 0.01347739
## Other 0.48658690 0.48645464
##
## Expected Counts assuming independence
## Asprin Placebo
## FatalNonFatal 297.5404 297.4596
## Other 10739.4596 10736.5404
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## FatalNonFatal -2.2922843 2.2925959
## Other 0.3815489 -0.3816008
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## FatalNonFatal 5.2545672 5.2559958
## Other 0.1455796 0.1456192
##
## Chi-Square Statistic: 10.80176
##
## degrees of freedom: 1
##
## P-Value : 0.001014035
# Incidence of cardiovascular events is lower under Aspirin vs Placebo
# but the significance is lower (though still significant relative to nominal levels)
# (a). Test 4
# Among those having MCI, evaluate whether
# fatality rate depends on Aspirin versus Placebo
fcn.chisqtest(tableD.1[1:2,])
##
## Two-Way Table:
## Asprin Placebo
## MCIFatal 10 26
## MCINonFatal 129 213
##
## Total Counts in Table: 378
##
## MLEs of row level probabilities
## MCIFatal MCINonFatal
## 0.0952381 0.9047619
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.3677249 0.6322751
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## MCIFatal 0.03502142 0.06021668
## MCINonFatal 0.33270345 0.57205845
##
## Expected Counts assuming independence
## Asprin Placebo
## MCIFatal 13.2381 22.7619
## MCINonFatal 125.7619 216.2381
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## MCIFatal -0.8899731 0.6787117
## MCINonFatal 0.2887454 -0.2202031
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## MCIFatal 0.7920521 0.46064953
## MCINonFatal 0.0833739 0.04848942
##
## Chi-Square Statistic: 1.384565
##
## degrees of freedom: 1
##
## P-Value : 0.2393251
# Not significant
# (a). Test 5 Incidence of strokes
tableD.4=rbind(
Strokes=colSums(tableD.1[c(3,4),]),
Other=colSums(tableD.1[c(1,2,5),]))
fcn.chisqtest(tableD.4)
##
## Two-Way Table:
## Asprin Placebo
## Strokes 119 98
## Other 10918 10936
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## Strokes Other
## 0.009831906 0.990168094
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## Strokes 0.004916621 0.004915285
## Other 0.495151341 0.495016753
##
## Expected Counts assuming independence
## Asprin Placebo
## Strokes 108.5147 108.4853
## Other 10928.4853 10925.5147
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## Strokes 1.0065480 -1.0066848
## Other -0.1002995 0.1003132
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## Strokes 1.013139 1.01341436
## Other 0.010060 0.01006273
##
## Chi-Square Statistic: 2.046676
##
## degrees of freedom: 1
##
## P-Value : 0.1525389
# Not significantly different
# (b). Table of cariovascular mortality
tableE=data.frame(
Asprin=rbind(
AcuteMCI=10,
OtherIHD=24,
SuddenDeath=22,
Stroke=10,
OtherCard=15),
Placebo=rbind(
AcuteMCI=28,
OtherIHD=25,
SuddenDeath=12,
Stroke=7,
OtherCard=11))
tableE.colSums=colSums(tableE)
tableE.1<-rbind(tableE,
None=((tableE.colSums*-1) +c(11037, 11034))
)
tableE.1
## Asprin Placebo
## AcuteMCI 10 28
## OtherIHD 24 25
## SuddenDeath 22 12
## Stroke 10 7
## OtherCard 15 11
## None 10956 10951
fcn.chisqtest(tableE.1)
##
## Two-Way Table:
## Asprin Placebo
## AcuteMCI 10 28
## OtherIHD 24 25
## SuddenDeath 22 12
## Stroke 10 7
## OtherCard 15 11
## None 10956 10951
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## AcuteMCI OtherIHD SuddenDeath Stroke OtherCard
## 0.0017217163 0.0022201078 0.0015404830 0.0007702415 0.0011780164
## None
## 0.9925694350
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## AcuteMCI 0.0008609752 0.0008607411
## OtherIHD 0.0011102048 0.0011099030
## SuddenDeath 0.0007703462 0.0007701368
## Stroke 0.0003851731 0.0003850684
## OtherCard 0.0005890883 0.0005889281
## None 0.4963521750 0.4962172600
##
## Expected Counts assuming independence
## Asprin Placebo
## AcuteMCI 19.002583 18.997417
## OtherIHD 24.503330 24.496670
## SuddenDeath 17.002311 16.997689
## Stroke 8.501155 8.498845
## OtherCard 13.001767 12.998233
## None 10954.988854 10952.011146
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## AcuteMCI -2.065193737 2.065474468
## OtherIHD -0.101681138 0.101694960
## SuddenDeath 1.212035322 -1.212200079
## Stroke 0.514064534 -0.514134412
## OtherCard 0.554172450 -0.554247781
## None 0.009660683 -0.009661996
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## AcuteMCI 4.2650251718 4.266185e+00
## OtherIHD 0.0103390539 1.034186e-02
## SuddenDeath 1.4690296219 1.469429e+00
## Stroke 0.2642623446 2.643342e-01
## OtherCard 0.3071071045 3.071906e-01
## None 0.0000933288 9.335417e-05
##
## Chi-Square Statistic: 12.63343
##
## degrees of freedom: 5
##
## P-Value : 0.0270671
# Mortality due to AcuteMCI is significantly reduced by Aspirin
# The P-value is 0.027
# (b). Test 2
# Evaluation of total cariovascular mortality:
tableE.2<-rbind(TotalCard=colSums(tableE.1[c(1:5),]),
None=tableE.1[6,])
fcn.chisqtest(tableE.2)
##
## Two-Way Table:
## Asprin Placebo
## TotalCard 81 83
## None 10956 10951
##
## Total Counts in Table: 22071
##
## MLEs of row level probabilities
## TotalCard None
## 0.007430565 0.992569435
##
## MLEs of column level probabilities
## Asprin Placebo
## 0.500068 0.499932
##
## Fitted cell probabilities assuming independence
## Asprin Placebo
## TotalCard 0.003715787 0.003714777
## None 0.496352175 0.496217260
##
## Expected Counts assuming independence
## Asprin Placebo
## TotalCard 82.01115 81.98885
## None 10954.98885 10952.01115
##
## Table of Chi-Square Residuals by cell
## Asprin Placebo
## TotalCard -0.111654791 0.111669969
## None 0.009660683 -0.009661996
##
## Table of Chi-Square statistic terms by cell
## Asprin Placebo
## TotalCard 0.0124667923 1.247018e-02
## None 0.0000933288 9.335417e-05
##
## Chi-Square Statistic: 0.02512366
##
## degrees of freedom: 1
##
## P-Value : 0.8740593
# Not significant