1 Preliminarities

library(tidyverse) # modern data science library
library(ggpubr) # for beautiful figures using ggplot in the background
library(car) # companion to applied regression analysis

2 What is Hypothesis Testing?

3 T-Test

4 Non-Parametric T-Tests

5 One-way ANOVA

  • An extension of independent two-samples t-test
  • Useful for comparing means when we have two or more groups
  • Data is organized into two or more groups based on one single grouping variable (also called factor variable)
data("PlantGrowth")
PlantGrowth
str(PlantGrowth)
'data.frame':   30 obs. of  2 variables:
 $ weight: num  4.17 5.58 5.18 6.11 4.5 4.61 5.17 4.53 5.33 5.14 ...
 $ group : Factor w/ 3 levels "ctrl","trt1",..: 1 1 1 1 1 1 1 1 1 1 ...
summary(PlantGrowth)
     weight       group   
 Min.   :3.590   ctrl:10  
 1st Qu.:4.550   trt1:10  
 Median :5.155   trt2:10  
 Mean   :5.073            
 3rd Qu.:5.530            
 Max.   :6.310            
levels(PlantGrowth$group)
[1] "ctrl" "trt1" "trt2"
ggboxplot(PlantGrowth, x = "group", y = "weight", 
          color = "group", palette = c("blue", "red", "green"),
          order = c("ctrl", "trt1", "trt2"),
          ylab = "Weight", xlab = "Treatment")

md <- aov(weight ~ group, data = PlantGrowth)
summary(md) 
            Df Sum Sq Mean Sq F value Pr(>F)  
group        2  3.766  1.8832   4.846 0.0159 *
Residuals   27 10.492  0.3886                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Since the p-value is less than 5 %, then there are significant differences between groups

5.1 Which of the groups are significantly different?

5.1.1 Post hoc test

t <- TukeyHSD(md)
t
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = weight ~ group, data = PlantGrowth)

$group
            diff        lwr       upr     p adj
trt1-ctrl -0.371 -1.0622161 0.3202161 0.3908711
trt2-ctrl  0.494 -0.1972161 1.1852161 0.1979960
trt2-trt1  0.865  0.1737839 1.5562161 0.0120064
plot(t)

Because only one of the comparison (trt2-trt1) shows a p-value is less than 5 %, then there is a statistically difference only between the groups trt2 and trt1

5.1.2 Pairwise t-test

pairwise.t.test(PlantGrowth$weight, PlantGrowth$group,
                p.adjust.method = "BH")

    Pairwise comparisons using t tests with pooled SD 

data:  PlantGrowth$weight and PlantGrowth$group 

     ctrl  trt1 
trt1 0.194 -    
trt2 0.132 0.013

P value adjustment method: BH 

5.2 Conditions of one way ANOVA

5.2.1 Homogeneity of the variance of the residuals

plot(md, 1)

The variance of the residuals seems to be largely homogeneous

5.2.2 Normality of residuals.

plot(md, 2)

# Extract the residuals
aov_residuals <- residuals(object = md )
# Run Shapiro-Wilk test
shapiro.test(x = aov_residuals ) 

    Shapiro-Wilk normality test

data:  aov_residuals
W = 0.96607, p-value = 0.4379

Since the p-value is more than 5% in the Shapiro-Wilk normality test, then the errors are normally distributed

6 Non-parametric ANOVA

7 Two way ANOVA

  • Useful to evaluate the effect of two factor variables on a response variable
  • Useful to evaluate the interaction effect of two factor variables The nule hypothesis is H0: response mean for all factor levels are equal
data("ToothGrowth")
df <- ToothGrowth
df
summary(df)
      len        supp         dose      
 Min.   : 4.20   OJ:30   Min.   :0.500  
 1st Qu.:13.07   VC:30   1st Qu.:0.500  
 Median :19.25           Median :1.000  
 Mean   :18.81           Mean   :1.167  
 3rd Qu.:25.27           3rd Qu.:2.000  
 Max.   :33.90           Max.   :2.000  
str(df)
'data.frame':   60 obs. of  3 variables:
 $ len : num  4.2 11.5 7.3 5.8 6.4 10 11.2 11.2 5.2 7 ...
 $ supp: Factor w/ 2 levels "OJ","VC": 2 2 2 2 2 2 2 2 2 2 ...
 $ dose: num  0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...

We need to convert the variable dose into a factor variable

df$dose <- factor(df$dose, 
                       levels = c(0.5, 1, 2),
                       labels = c("D0.5", "D1", "D2"))
boxplot(len ~ supp * dose, data=df, frame = FALSE, 
        col = c("red", "blue"), ylab="Tooth Length")

Let’s see if tooth length depends on supp and dose.

7.1 Assuming that two factor variables are independent

md1 <- aov(len ~ supp + dose, data = df)
summary(md1)
            Df Sum Sq Mean Sq F value   Pr(>F)    
supp         1  205.4   205.4   14.02 0.000429 ***
dose         2 2426.4  1213.2   82.81  < 2e-16 ***
Residuals   56  820.4    14.7                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Both supp and dose are statistically significant

Assuming Mean tooth length for both supp and dose are NOT equal

7.2 Testing the interaction effect

Let’s test wheater two variables might interact to create a interactive a synergistic effect

md2 <- aov(len ~ supp * dose, data = df)
summary(md2)
            Df Sum Sq Mean Sq F value   Pr(>F)    
supp         1  205.4   205.4  15.572 0.000231 ***
dose         2 2426.4  1213.2  92.000  < 2e-16 ***
supp:dose    2  108.3    54.2   4.107 0.021860 *  
Residuals   54  712.1    13.2                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

The two main effects (supp and dose) are statistically significant, as well as their interaction

  • relationships between dose and tooth length depends on the supp method
  • influence the difference between mean tooth length

7.3 Post Hoc test

To identify which dosage group is different

TukeyHSD(md2, which = "dose")
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = len ~ supp * dose, data = df)

$dose
          diff       lwr       upr   p adj
D1-D0.5  9.130  6.362488 11.897512 0.0e+00
D2-D0.5 15.495 12.727488 18.262512 0.0e+00
D2-D1    6.365  3.597488  9.132512 2.7e-06

7.4 Pairwise t-tests

pairwise.t.test(df$len, df$dose,
                p.adjust.method = "BH")

    Pairwise comparisons using t tests with pooled SD 

data:  df$len and df$dose 

   D0.5    D1     
D1 1.0e-08 -      
D2 4.4e-16 1.4e-05

P value adjustment method: BH 

7.5 Testing when we have unequal sample numbers

mya <- aov(len ~ supp * dose, data = df)
Anova(mya, type = "III") # Type-III sums of squares used when we have unequal numbers per group
Anova Table (Type III tests)

Response: len
             Sum Sq Df F value    Pr(>F)    
(Intercept) 1750.33  1 132.730 3.603e-16 ***
supp         137.81  1  10.450  0.002092 ** 
dose         885.26  2  33.565 3.363e-10 ***
supp:dose    108.32  2   4.107  0.021860 *  
Residuals    712.11 54                      
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Note that his Anova() functions is from the car package

7.6 Testing the condtions for a two-way anova

7.6.1 Homogeneity of variance of residuals

plot(md2, 1)

7.6.2 Normality of residuals

plot(md2, 2)

aov_residuals <- residuals(object = md2 )
shapiro.test(x = aov_residuals ) #errors are normally distributed

    Shapiro-Wilk normality test

data:  aov_residuals
W = 0.98499, p-value = 0.6694

8 Power Test for Detecting Effect

LS0tCnRpdGxlOiAiU3RhdGlzdGljYWwgSW5mZXJlbmNlIgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0aGVtZTogY29zbW8KICAgIGhpZ2hsaWdodDogbW9ub2Nocm9tZQogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIHRvY19kZXB0aDogNAogICAgbnVtYmVyX3NlY3Rpb25zOiB0cnVlCiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUKICAgIGRmX3ByaW50OiBrYWJsZQogIGdpdGh1Yl9kb2N1bWVudDogZGVmYXVsdAotLS0KCjxzdHlsZT4KCmgxLnRpdGxlIHsgCiAgZm9udC1zaXplOiAxOHB0OyAKICBjb2xvcjogRGFya0JsdWU7IAp9IAoKYm9keSwgaDEsIGgyLCBoMywgaDQgewogICAgZm9udC1mYW1pbHk6ICJQYWxhdGlubyIsIHNlcmlmOwp9Cgpib2R5IHsKICAgIGZvbnQtc2l6ZTogMTJwdDsKfQoKLyogSGVhZGVycyAqLwpoMSxoMixoMyxoNCxoNSxoNnsKICBmb250LXNpemU6IDE0cHQ7CiAgY29sb3I6ICMwMDAwOEI7Cn0KCmJvZHkgewogICAgY29sb3I6ICMzMzMzMzM7Cn0KYSwgYTpob3ZlciB7CiAgICBjb2xvcjogIzhCM0E2MjsKfQpwcmUgewogICAgZm9udC1zaXplOiAxMnB4Owp9Cjwvc3R5bGU+CgoKCiMgUHJlbGltaW5hcml0aWVzIAoKLSBUaGlzIGRvY3VtZW50IGlzIGluc3BpcmVkIGJ5IHRoZSBzY3JpcHRzIG9mIHRoZSBjb3Vyc2UgWypEYXRhIFNjaWVuY2UgQWNhZGVteTogTWFzdGVyIERhdGEgU2NpZW5jZSBJbiBSKl0oaHR0cHM6Ly93d3cudWRlbXkuY29tL2RhdGEtc2NpZW5jZS1pbi1yLykKCi0gQW4gaW50ZXJhY3RpdmUgdmVyc2lvbiBvZiB0aGlzIGRvY3VtZW50IGlzIGF2YWlsYWJsZSBpbiBbUiBTdHVkaW8gQ2xvdWRdKGh0dHBzOi8vcnN0dWRpby5jbG91ZC9zcGFjZXMvMTc4MS9wcm9qZWN0LzM1NTE2KQoKLSBUaGUgcGFja2FnZXMgbmVlZGVkIHRvIGV4ZWN1dGUgdGhpcyBkb2N1bWVudCBhcmUgYXMgZm9sbG93czogCgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KHRpZHl2ZXJzZSkgIyBtb2Rlcm4gZGF0YSBzY2llbmNlIGxpYnJhcnkKbGlicmFyeShnZ3B1YnIpICMgZm9yIGJlYXV0aWZ1bCBmaWd1cmVzIHVzaW5nIGdncGxvdCBpbiB0aGUgYmFja2dyb3VuZApsaWJyYXJ5KGNhcikgIyBjb21wYW5pb24gdG8gYXBwbGllZCByZWdyZXNzaW9uIGFuYWx5c2lzCmBgYAoKCgojIFdoYXQgaXMgSHlwb3RoZXNpcyBUZXN0aW5nPwojIFQtVGVzdAojIE5vbi1QYXJhbWV0cmljIFQtVGVzdHMKIyBPbmUtd2F5IEFOT1ZBCgotIEFuIGV4dGVuc2lvbiBvZiBpbmRlcGVuZGVudCB0d28tc2FtcGxlcyB0LXRlc3QgCi0gVXNlZnVsIGZvciAqKmNvbXBhcmluZyBtZWFucyB3aGVuIHdlIGhhdmUgdHdvIG9yIG1vcmUgZ3JvdXBzKioKLSBEYXRhIGlzIG9yZ2FuaXplZCBpbnRvIHR3byBvciBtb3JlIGdyb3VwcyBiYXNlZCBvbiBvbmUgc2luZ2xlIGdyb3VwaW5nIHZhcmlhYmxlIChhbHNvIGNhbGxlZCBmYWN0b3IgdmFyaWFibGUpCgpgYGB7cn0KZGF0YSgiUGxhbnRHcm93dGgiKQpQbGFudEdyb3d0aApzdHIoUGxhbnRHcm93dGgpCnN1bW1hcnkoUGxhbnRHcm93dGgpCmxldmVscyhQbGFudEdyb3d0aCRncm91cCkKYGBgCgoKCgoKYGBge3J9CmdnYm94cGxvdChQbGFudEdyb3d0aCwgeCA9ICJncm91cCIsIHkgPSAid2VpZ2h0IiwgCiAgICAgICAgICBjb2xvciA9ICJncm91cCIsIHBhbGV0dGUgPSBjKCJibHVlIiwgInJlZCIsICJncmVlbiIpLAogICAgICAgICAgb3JkZXIgPSBjKCJjdHJsIiwgInRydDEiLCAidHJ0MiIpLAogICAgICAgICAgeWxhYiA9ICJXZWlnaHQiLCB4bGFiID0gIlRyZWF0bWVudCIpCmBgYAoKCgpgYGB7cn0KbWQgPC0gYW92KHdlaWdodCB+IGdyb3VwLCBkYXRhID0gUGxhbnRHcm93dGgpCnN1bW1hcnkobWQpIAoKYGBgCgoKU2luY2UgdGhlIHAtdmFsdWUgaXMgbGVzcyB0aGFuIDUgJSwgdGhlbiB0aGVyZSBhcmUgc2lnbmlmaWNhbnQgZGlmZmVyZW5jZXMgYmV0d2VlbiAgZ3JvdXBzICAKCiMjIFdoaWNoIG9mIHRoZSBncm91cHMgYXJlIHNpZ25pZmljYW50bHkgZGlmZmVyZW50PwoKIyMjIFBvc3QgaG9jIHRlc3QKCmBgYHtyfQp0IDwtIFR1a2V5SFNEKG1kKQp0CnBsb3QodCkKYGBgCgoKCkJlY2F1c2Ugb25seSBvbmUgb2YgdGhlIGNvbXBhcmlzb24gKHRydDItdHJ0MSkgIHNob3dzIGEgcC12YWx1ZSBpcyBsZXNzIHRoYW4gNSAlLCB0aGVuIHRoZXJlIGlzIGEgc3RhdGlzdGljYWxseSBkaWZmZXJlbmNlIG9ubHkgYmV0d2VlbiB0aGUgZ3JvdXBzIHRydDIgYW5kIHRydDEgCgojIyMgUGFpcndpc2UgdC10ZXN0CgpgYGB7cn0KcGFpcndpc2UudC50ZXN0KFBsYW50R3Jvd3RoJHdlaWdodCwgUGxhbnRHcm93dGgkZ3JvdXAsCiAgICAgICAgICAgICAgICBwLmFkanVzdC5tZXRob2QgPSAiQkgiKQpgYGAKCgojIyBDb25kaXRpb25zIG9mIG9uZSB3YXkgQU5PVkEKCiMjIyBIb21vZ2VuZWl0eSBvZiB0aGUgdmFyaWFuY2Ugb2YgdGhlIHJlc2lkdWFscwoKYGBge3J9CnBsb3QobWQsIDEpCmBgYAoKVGhlIHZhcmlhbmNlIG9mIHRoZSByZXNpZHVhbHMgc2VlbXMgdG8gYmUgbGFyZ2VseSBob21vZ2VuZW91cwoKIyMjIE5vcm1hbGl0eSBvZiByZXNpZHVhbHMuCgpgYGB7cn0KcGxvdChtZCwgMikKYGBgCgoKYGBge3J9CiMgRXh0cmFjdCB0aGUgcmVzaWR1YWxzCmFvdl9yZXNpZHVhbHMgPC0gcmVzaWR1YWxzKG9iamVjdCA9IG1kICkKIyBSdW4gU2hhcGlyby1XaWxrIHRlc3QKc2hhcGlyby50ZXN0KHggPSBhb3ZfcmVzaWR1YWxzICkgCmBgYAoKClNpbmNlIHRoZSBwLXZhbHVlIGlzIG1vcmUgdGhhbiA1JSBpbiB0aGUgU2hhcGlyby1XaWxrIG5vcm1hbGl0eSB0ZXN0LCB0aGVuIHRoZSBlcnJvcnMgYXJlIG5vcm1hbGx5IGRpc3RyaWJ1dGVkIAoKIyBOb24tcGFyYW1ldHJpYyBBTk9WQQoKIyBUd28gd2F5IEFOT1ZBCgotIFVzZWZ1bCB0byBldmFsdWF0ZSB0aGUgZWZmZWN0IG9mIHR3byBmYWN0b3IgdmFyaWFibGVzIG9uIGEgcmVzcG9uc2UgdmFyaWFibGUKLSBVc2VmdWwgdG8gZXZhbHVhdGUgdGhlIGludGVyYWN0aW9uIGVmZmVjdCBvZiB0d28gZmFjdG9yIHZhcmlhYmxlcwpUaGUgbnVsZSBoeXBvdGhlc2lzIGlzICpIMDogcmVzcG9uc2UgbWVhbiBmb3IgYWxsIGZhY3RvciBsZXZlbHMgYXJlIGVxdWFsKgoKYGBge3J9CmRhdGEoIlRvb3RoR3Jvd3RoIikKZGYgPC0gVG9vdGhHcm93dGgKZGYKc3VtbWFyeShkZikKc3RyKGRmKQpgYGAKCgpXZSBuZWVkIHRvIGNvbnZlcnQgdGhlIHZhcmlhYmxlIGBkb3NlYCBpbnRvIGEgZmFjdG9yIHZhcmlhYmxlCgpgYGB7cn0KZGYkZG9zZSA8LSBmYWN0b3IoZGYkZG9zZSwgCiAgICAgICAgICAgICAgICAgICAgICAgbGV2ZWxzID0gYygwLjUsIDEsIDIpLAogICAgICAgICAgICAgICAgICAgICAgIGxhYmVscyA9IGMoIkQwLjUiLCAiRDEiLCAiRDIiKSkKYGBgCgoKYGBge3J9CmJveHBsb3QobGVuIH4gc3VwcCAqIGRvc2UsIGRhdGE9ZGYsIGZyYW1lID0gRkFMU0UsIAogICAgICAgIGNvbCA9IGMoInJlZCIsICJibHVlIiksIHlsYWI9IlRvb3RoIExlbmd0aCIpCmBgYAoKCkxldCdzIHNlZSBpZiB0b290aCBsZW5ndGggZGVwZW5kcyBvbiBzdXBwIGFuZCBkb3NlLgoKIyMgQXNzdW1pbmcgdGhhdCB0d28gZmFjdG9yIHZhcmlhYmxlcyBhcmUgaW5kZXBlbmRlbnQKCmBgYHtyfQptZDEgPC0gYW92KGxlbiB+IHN1cHAgKyBkb3NlLCBkYXRhID0gZGYpCnN1bW1hcnkobWQxKQpgYGAKCgpCb3RoIHN1cHAgYW5kIGRvc2UgYXJlIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQKCkFzc3VtaW5nIE1lYW4gdG9vdGggbGVuZ3RoICBmb3IgYm90aCBzdXBwIGFuZCBkb3NlIGFyZSBOT1QgZXF1YWwKCiMjIFRlc3RpbmcgdGhlIGludGVyYWN0aW9uIGVmZmVjdCAKCkxldCdzIHRlc3Qgd2hlYXRlciB0d28gdmFyaWFibGVzIG1pZ2h0IGludGVyYWN0IHRvIGNyZWF0ZSBhIGludGVyYWN0aXZlIGEgc3luZXJnaXN0aWMgZWZmZWN0CgpgYGB7cn0KbWQyIDwtIGFvdihsZW4gfiBzdXBwICogZG9zZSwgZGF0YSA9IGRmKQpzdW1tYXJ5KG1kMikKYGBgCgoKVGhlIHR3byBtYWluIGVmZmVjdHMgKHN1cHAgYW5kIGRvc2UpIGFyZSBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50LCBhcyB3ZWxsIGFzIHRoZWlyIGludGVyYWN0aW9uCgotIHJlbGF0aW9uc2hpcHMgYmV0d2VlbiBkb3NlIGFuZCB0b290aCBsZW5ndGggZGVwZW5kcyBvbiB0aGUgc3VwcCBtZXRob2QKLSBpbmZsdWVuY2UgdGhlIGRpZmZlcmVuY2UgYmV0d2VlbiBtZWFuIHRvb3RoIGxlbmd0aAoKIyMgUG9zdCBIb2MgdGVzdCAKClRvIGlkZW50aWZ5IHdoaWNoIGRvc2FnZSBncm91cCBpcyBkaWZmZXJlbnQKCmBgYHtyfQpUdWtleUhTRChtZDIsIHdoaWNoID0gImRvc2UiKQpgYGAKCgojIyBQYWlyd2lzZSB0LXRlc3RzCgpgYGB7cn0KcGFpcndpc2UudC50ZXN0KGRmJGxlbiwgZGYkZG9zZSwKICAgICAgICAgICAgICAgIHAuYWRqdXN0Lm1ldGhvZCA9ICJCSCIpCmBgYAoKIyMgVGVzdGluZyB3aGVuIHdlIGhhdmUgdW5lcXVhbCBzYW1wbGUgbnVtYmVycwoKYGBge3J9Cm15YSA8LSBhb3YobGVuIH4gc3VwcCAqIGRvc2UsIGRhdGEgPSBkZikKQW5vdmEobXlhLCB0eXBlID0gIklJSSIpICMgVHlwZS1JSUkgc3VtcyBvZiBzcXVhcmVzIHVzZWQgd2hlbiB3ZSBoYXZlIHVuZXF1YWwgbnVtYmVycyBwZXIgZ3JvdXAKYGBgCgoKTm90ZSB0aGF0IGhpcyBgQW5vdmEoKWAgZnVuY3Rpb25zIGlzIGZyb20gdGhlIGBjYXJgIHBhY2thZ2UKCiMjIFRlc3RpbmcgdGhlIGNvbmR0aW9ucyBmb3IgYSB0d28td2F5IGFub3ZhCgojIyMgSG9tb2dlbmVpdHkgb2YgdmFyaWFuY2Ugb2YgcmVzaWR1YWxzCgpgYGB7cn0KcGxvdChtZDIsIDEpCmBgYAoKCiMjIyBOb3JtYWxpdHkgb2YgcmVzaWR1YWxzCgpgYGB7cn0KcGxvdChtZDIsIDIpCmBgYAoKCmBgYHtyfQphb3ZfcmVzaWR1YWxzIDwtIHJlc2lkdWFscyhvYmplY3QgPSBtZDIgKQpzaGFwaXJvLnRlc3QoeCA9IGFvdl9yZXNpZHVhbHMgKSAjZXJyb3JzIGFyZSBub3JtYWxseSBkaXN0cmlidXRlZApgYGAKCgojIFBvd2VyIFRlc3QgZm9yIERldGVjdGluZyBFZmZlY3QK