#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