Preliminarities
library(tidyverse) # modern data science library
library(ggpubr) # for beautiful figures using ggplot in the background
library(car) # companion to applied regression analysis
What is Hypothesis Testing?
T-Test
Non-Parametric T-Tests
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
'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 ...
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
Which of the groups are significantly different?
Post hoc test
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

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
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
Conditions of one way ANOVA
Homogeneity of the variance of the residuals

The variance of the residuals seems to be largely homogeneous
Normality of residuals.

# 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
Non-parametric ANOVA
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
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
'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.
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
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
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
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
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
Testing the condtions for a two-way anova
Homogeneity of variance of residuals

Normality of residuals

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
Power Test for Detecting Effect
LS0tCnRpdGxlOiAiU3RhdGlzdGljYWwgSW5mZXJlbmNlIgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0aGVtZTogY29zbW8KICAgIGhpZ2hsaWdodDogbW9ub2Nocm9tZQogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIHRvY19kZXB0aDogNAogICAgbnVtYmVyX3NlY3Rpb25zOiB0cnVlCiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUKICAgIGRmX3ByaW50OiBrYWJsZQogIGdpdGh1Yl9kb2N1bWVudDogZGVmYXVsdAotLS0KCjxzdHlsZT4KCmgxLnRpdGxlIHsgCiAgZm9udC1zaXplOiAxOHB0OyAKICBjb2xvcjogRGFya0JsdWU7IAp9IAoKYm9keSwgaDEsIGgyLCBoMywgaDQgewogICAgZm9udC1mYW1pbHk6ICJQYWxhdGlubyIsIHNlcmlmOwp9Cgpib2R5IHsKICAgIGZvbnQtc2l6ZTogMTJwdDsKfQoKLyogSGVhZGVycyAqLwpoMSxoMixoMyxoNCxoNSxoNnsKICBmb250LXNpemU6IDE0cHQ7CiAgY29sb3I6ICMwMDAwOEI7Cn0KCmJvZHkgewogICAgY29sb3I6ICMzMzMzMzM7Cn0KYSwgYTpob3ZlciB7CiAgICBjb2xvcjogIzhCM0E2MjsKfQpwcmUgewogICAgZm9udC1zaXplOiAxMnB4Owp9Cjwvc3R5bGU+CgoKCiMgUHJlbGltaW5hcml0aWVzIAoKLSBUaGlzIGRvY3VtZW50IGlzIGluc3BpcmVkIGJ5IHRoZSBzY3JpcHRzIG9mIHRoZSBjb3Vyc2UgWypEYXRhIFNjaWVuY2UgQWNhZGVteTogTWFzdGVyIERhdGEgU2NpZW5jZSBJbiBSKl0oaHR0cHM6Ly93d3cudWRlbXkuY29tL2RhdGEtc2NpZW5jZS1pbi1yLykKCi0gQW4gaW50ZXJhY3RpdmUgdmVyc2lvbiBvZiB0aGlzIGRvY3VtZW50IGlzIGF2YWlsYWJsZSBpbiBbUiBTdHVkaW8gQ2xvdWRdKGh0dHBzOi8vcnN0dWRpby5jbG91ZC9zcGFjZXMvMTc4MS9wcm9qZWN0LzM1NTE2KQoKLSBUaGUgcGFja2FnZXMgbmVlZGVkIHRvIGV4ZWN1dGUgdGhpcyBkb2N1bWVudCBhcmUgYXMgZm9sbG93czogCgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KHRpZHl2ZXJzZSkgIyBtb2Rlcm4gZGF0YSBzY2llbmNlIGxpYnJhcnkKbGlicmFyeShnZ3B1YnIpICMgZm9yIGJlYXV0aWZ1bCBmaWd1cmVzIHVzaW5nIGdncGxvdCBpbiB0aGUgYmFja2dyb3VuZApsaWJyYXJ5KGNhcikgIyBjb21wYW5pb24gdG8gYXBwbGllZCByZWdyZXNzaW9uIGFuYWx5c2lzCmBgYAoKCgojIFdoYXQgaXMgSHlwb3RoZXNpcyBUZXN0aW5nPwojIFQtVGVzdAojIE5vbi1QYXJhbWV0cmljIFQtVGVzdHMKIyBPbmUtd2F5IEFOT1ZBCgotIEFuIGV4dGVuc2lvbiBvZiBpbmRlcGVuZGVudCB0d28tc2FtcGxlcyB0LXRlc3QgCi0gVXNlZnVsIGZvciAqKmNvbXBhcmluZyBtZWFucyB3aGVuIHdlIGhhdmUgdHdvIG9yIG1vcmUgZ3JvdXBzKioKLSBEYXRhIGlzIG9yZ2FuaXplZCBpbnRvIHR3byBvciBtb3JlIGdyb3VwcyBiYXNlZCBvbiBvbmUgc2luZ2xlIGdyb3VwaW5nIHZhcmlhYmxlIChhbHNvIGNhbGxlZCBmYWN0b3IgdmFyaWFibGUpCgpgYGB7cn0KZGF0YSgiUGxhbnRHcm93dGgiKQpQbGFudEdyb3d0aApzdHIoUGxhbnRHcm93dGgpCnN1bW1hcnkoUGxhbnRHcm93dGgpCmxldmVscyhQbGFudEdyb3d0aCRncm91cCkKYGBgCgoKCgoKYGBge3J9CmdnYm94cGxvdChQbGFudEdyb3d0aCwgeCA9ICJncm91cCIsIHkgPSAid2VpZ2h0IiwgCiAgICAgICAgICBjb2xvciA9ICJncm91cCIsIHBhbGV0dGUgPSBjKCJibHVlIiwgInJlZCIsICJncmVlbiIpLAogICAgICAgICAgb3JkZXIgPSBjKCJjdHJsIiwgInRydDEiLCAidHJ0MiIpLAogICAgICAgICAgeWxhYiA9ICJXZWlnaHQiLCB4bGFiID0gIlRyZWF0bWVudCIpCmBgYAoKCgpgYGB7cn0KbWQgPC0gYW92KHdlaWdodCB+IGdyb3VwLCBkYXRhID0gUGxhbnRHcm93dGgpCnN1bW1hcnkobWQpIAoKYGBgCgoKU2luY2UgdGhlIHAtdmFsdWUgaXMgbGVzcyB0aGFuIDUgJSwgdGhlbiB0aGVyZSBhcmUgc2lnbmlmaWNhbnQgZGlmZmVyZW5jZXMgYmV0d2VlbiAgZ3JvdXBzICAKCiMjIFdoaWNoIG9mIHRoZSBncm91cHMgYXJlIHNpZ25pZmljYW50bHkgZGlmZmVyZW50PwoKIyMjIFBvc3QgaG9jIHRlc3QKCmBgYHtyfQp0IDwtIFR1a2V5SFNEKG1kKQp0CnBsb3QodCkKYGBgCgoKCkJlY2F1c2Ugb25seSBvbmUgb2YgdGhlIGNvbXBhcmlzb24gKHRydDItdHJ0MSkgIHNob3dzIGEgcC12YWx1ZSBpcyBsZXNzIHRoYW4gNSAlLCB0aGVuIHRoZXJlIGlzIGEgc3RhdGlzdGljYWxseSBkaWZmZXJlbmNlIG9ubHkgYmV0d2VlbiB0aGUgZ3JvdXBzIHRydDIgYW5kIHRydDEgCgojIyMgUGFpcndpc2UgdC10ZXN0CgpgYGB7cn0KcGFpcndpc2UudC50ZXN0KFBsYW50R3Jvd3RoJHdlaWdodCwgUGxhbnRHcm93dGgkZ3JvdXAsCiAgICAgICAgICAgICAgICBwLmFkanVzdC5tZXRob2QgPSAiQkgiKQpgYGAKCgojIyBDb25kaXRpb25zIG9mIG9uZSB3YXkgQU5PVkEKCiMjIyBIb21vZ2VuZWl0eSBvZiB0aGUgdmFyaWFuY2Ugb2YgdGhlIHJlc2lkdWFscwoKYGBge3J9CnBsb3QobWQsIDEpCmBgYAoKVGhlIHZhcmlhbmNlIG9mIHRoZSByZXNpZHVhbHMgc2VlbXMgdG8gYmUgbGFyZ2VseSBob21vZ2VuZW91cwoKIyMjIE5vcm1hbGl0eSBvZiByZXNpZHVhbHMuCgpgYGB7cn0KcGxvdChtZCwgMikKYGBgCgoKYGBge3J9CiMgRXh0cmFjdCB0aGUgcmVzaWR1YWxzCmFvdl9yZXNpZHVhbHMgPC0gcmVzaWR1YWxzKG9iamVjdCA9IG1kICkKIyBSdW4gU2hhcGlyby1XaWxrIHRlc3QKc2hhcGlyby50ZXN0KHggPSBhb3ZfcmVzaWR1YWxzICkgCmBgYAoKClNpbmNlIHRoZSBwLXZhbHVlIGlzIG1vcmUgdGhhbiA1JSBpbiB0aGUgU2hhcGlyby1XaWxrIG5vcm1hbGl0eSB0ZXN0LCB0aGVuIHRoZSBlcnJvcnMgYXJlIG5vcm1hbGx5IGRpc3RyaWJ1dGVkIAoKIyBOb24tcGFyYW1ldHJpYyBBTk9WQQoKIyBUd28gd2F5IEFOT1ZBCgotIFVzZWZ1bCB0byBldmFsdWF0ZSB0aGUgZWZmZWN0IG9mIHR3byBmYWN0b3IgdmFyaWFibGVzIG9uIGEgcmVzcG9uc2UgdmFyaWFibGUKLSBVc2VmdWwgdG8gZXZhbHVhdGUgdGhlIGludGVyYWN0aW9uIGVmZmVjdCBvZiB0d28gZmFjdG9yIHZhcmlhYmxlcwpUaGUgbnVsZSBoeXBvdGhlc2lzIGlzICpIMDogcmVzcG9uc2UgbWVhbiBmb3IgYWxsIGZhY3RvciBsZXZlbHMgYXJlIGVxdWFsKgoKYGBge3J9CmRhdGEoIlRvb3RoR3Jvd3RoIikKZGYgPC0gVG9vdGhHcm93dGgKZGYKc3VtbWFyeShkZikKc3RyKGRmKQpgYGAKCgpXZSBuZWVkIHRvIGNvbnZlcnQgdGhlIHZhcmlhYmxlIGBkb3NlYCBpbnRvIGEgZmFjdG9yIHZhcmlhYmxlCgpgYGB7cn0KZGYkZG9zZSA8LSBmYWN0b3IoZGYkZG9zZSwgCiAgICAgICAgICAgICAgICAgICAgICAgbGV2ZWxzID0gYygwLjUsIDEsIDIpLAogICAgICAgICAgICAgICAgICAgICAgIGxhYmVscyA9IGMoIkQwLjUiLCAiRDEiLCAiRDIiKSkKYGBgCgoKYGBge3J9CmJveHBsb3QobGVuIH4gc3VwcCAqIGRvc2UsIGRhdGE9ZGYsIGZyYW1lID0gRkFMU0UsIAogICAgICAgIGNvbCA9IGMoInJlZCIsICJibHVlIiksIHlsYWI9IlRvb3RoIExlbmd0aCIpCmBgYAoKCkxldCdzIHNlZSBpZiB0b290aCBsZW5ndGggZGVwZW5kcyBvbiBzdXBwIGFuZCBkb3NlLgoKIyMgQXNzdW1pbmcgdGhhdCB0d28gZmFjdG9yIHZhcmlhYmxlcyBhcmUgaW5kZXBlbmRlbnQKCmBgYHtyfQptZDEgPC0gYW92KGxlbiB+IHN1cHAgKyBkb3NlLCBkYXRhID0gZGYpCnN1bW1hcnkobWQxKQpgYGAKCgpCb3RoIHN1cHAgYW5kIGRvc2UgYXJlIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQKCkFzc3VtaW5nIE1lYW4gdG9vdGggbGVuZ3RoICBmb3IgYm90aCBzdXBwIGFuZCBkb3NlIGFyZSBOT1QgZXF1YWwKCiMjIFRlc3RpbmcgdGhlIGludGVyYWN0aW9uIGVmZmVjdCAKCkxldCdzIHRlc3Qgd2hlYXRlciB0d28gdmFyaWFibGVzIG1pZ2h0IGludGVyYWN0IHRvIGNyZWF0ZSBhIGludGVyYWN0aXZlIGEgc3luZXJnaXN0aWMgZWZmZWN0CgpgYGB7cn0KbWQyIDwtIGFvdihsZW4gfiBzdXBwICogZG9zZSwgZGF0YSA9IGRmKQpzdW1tYXJ5KG1kMikKYGBgCgoKVGhlIHR3byBtYWluIGVmZmVjdHMgKHN1cHAgYW5kIGRvc2UpIGFyZSBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50LCBhcyB3ZWxsIGFzIHRoZWlyIGludGVyYWN0aW9uCgotIHJlbGF0aW9uc2hpcHMgYmV0d2VlbiBkb3NlIGFuZCB0b290aCBsZW5ndGggZGVwZW5kcyBvbiB0aGUgc3VwcCBtZXRob2QKLSBpbmZsdWVuY2UgdGhlIGRpZmZlcmVuY2UgYmV0d2VlbiBtZWFuIHRvb3RoIGxlbmd0aAoKIyMgUG9zdCBIb2MgdGVzdCAKClRvIGlkZW50aWZ5IHdoaWNoIGRvc2FnZSBncm91cCBpcyBkaWZmZXJlbnQKCmBgYHtyfQpUdWtleUhTRChtZDIsIHdoaWNoID0gImRvc2UiKQpgYGAKCgojIyBQYWlyd2lzZSB0LXRlc3RzCgpgYGB7cn0KcGFpcndpc2UudC50ZXN0KGRmJGxlbiwgZGYkZG9zZSwKICAgICAgICAgICAgICAgIHAuYWRqdXN0Lm1ldGhvZCA9ICJCSCIpCmBgYAoKIyMgVGVzdGluZyB3aGVuIHdlIGhhdmUgdW5lcXVhbCBzYW1wbGUgbnVtYmVycwoKYGBge3J9Cm15YSA8LSBhb3YobGVuIH4gc3VwcCAqIGRvc2UsIGRhdGEgPSBkZikKQW5vdmEobXlhLCB0eXBlID0gIklJSSIpICMgVHlwZS1JSUkgc3VtcyBvZiBzcXVhcmVzIHVzZWQgd2hlbiB3ZSBoYXZlIHVuZXF1YWwgbnVtYmVycyBwZXIgZ3JvdXAKYGBgCgoKTm90ZSB0aGF0IGhpcyBgQW5vdmEoKWAgZnVuY3Rpb25zIGlzIGZyb20gdGhlIGBjYXJgIHBhY2thZ2UKCiMjIFRlc3RpbmcgdGhlIGNvbmR0aW9ucyBmb3IgYSB0d28td2F5IGFub3ZhCgojIyMgSG9tb2dlbmVpdHkgb2YgdmFyaWFuY2Ugb2YgcmVzaWR1YWxzCgpgYGB7cn0KcGxvdChtZDIsIDEpCmBgYAoKCiMjIyBOb3JtYWxpdHkgb2YgcmVzaWR1YWxzCgpgYGB7cn0KcGxvdChtZDIsIDIpCmBgYAoKCmBgYHtyfQphb3ZfcmVzaWR1YWxzIDwtIHJlc2lkdWFscyhvYmplY3QgPSBtZDIgKQpzaGFwaXJvLnRlc3QoeCA9IGFvdl9yZXNpZHVhbHMgKSAjZXJyb3JzIGFyZSBub3JtYWxseSBkaXN0cmlidXRlZApgYGAKCgojIFBvd2VyIFRlc3QgZm9yIERldGVjdGluZyBFZmZlY3QK