Anova, Ancova, Manova
Sprawdzamy równoliczność grup
table(Salaries$rank, Salaries$discipline)##
## A B
## AsstProf 24 43
## AssocProf 26 38
## Prof 131 135table(Salaries$rank, Salaries$sex)##
## Female Male
## AsstProf 11 56
## AssocProf 10 54
## Prof 18 248table(Salaries$discipline, Salaries$sex)##
## Female Male
## A 18 163
## B 21 195Grupy nie są równoliczne.
Wykresy skrzynkowe dla wielkości wynagrodzenia wśród mężczyzn oraz kobiet
ggboxplot(Salaries, x="rank", y="salary", color="discipline", facet.by="sex")
data(Salaries)
ggplot(Salaries, aes(x=salary)) +
geom_histogram(bins=10) +
facet_grid(rank~sex~discipline)
Badanie normalności
Salaries %>%
group_by(rank,discipline,sex) %>%
shapiro_test(salary)## # A tibble: 12 x 6
## rank discipline sex variable statistic p
## <fct> <fct> <fct> <chr> <dbl> <dbl>
## 1 AsstProf A Female salary 0.870 0.226
## 2 AsstProf A Male salary 0.941 0.300
## 3 AsstProf B Female salary 0.889 0.354
## 4 AsstProf B Male salary 0.941 0.0458
## 5 AssocProf A Female salary 0.863 0.269
## 6 AssocProf A Male salary 0.878 0.0113
## 7 AssocProf B Female salary 0.635 0.00117
## 8 AssocProf B Male salary 0.967 0.416
## 9 Prof A Female salary 0.934 0.549
## 10 Prof A Male salary 0.952 0.000259
## 11 Prof B Female salary 0.974 0.923
## 12 Prof B Male salary 0.978 0.0435Dla 5 grup P-value < 0.05, zatem nie możemy uznać normalnego rozkładu.
Zobaczmy, jak wyglądają wykresy normalności wg podgrup:
ggqqplot(Salaries, "salary") +
facet_grid(sex~discipline~rank)
#Jednorodność wariancji
Założenie jednorodności wariancji
Salaries %>%
levene_test(salary ~ rank*sex*discipline)## # A tibble: 1 x 4
## df1 df2 statistic p
## <int> <int> <dbl> <dbl>
## 1 11 385 9.05 2.06e-14P-value < 0.05, a więc stwierdzamy występowanie istotnej różnicy wariancji (odrzucamy hipotezę zerową). Zatem wariancje nie są jednorodne.
Sprawdzamy występowanie wartości odstających, a następnie usuwamy je
wartosci.odstajace <- Salaries %>%
group_by(rank,discipline,sex) %>%
identify_outliers(salary)
wartosci.odstajace## # A tibble: 18 x 8
## rank discipline sex yrs.since.phd yrs.service salary is.outlier is.extreme
## <fct> <fct> <fct> <int> <int> <int> <lgl> <lgl>
## 1 AsstProf A Female 7 6 63100 TRUE FALSE
## 2 AsstProf A Male 3 1 63900 TRUE FALSE
## 3 AsstProf A Male 2 0 85000 TRUE TRUE
## 4 AsstProf A Male 8 4 81035 TRUE FALSE
## 5 AssocProf A Female 25 22 62884 TRUE FALSE
## 6 AssocProf A Male 14 8 100102 TRUE FALSE
## 7 AssocProf A Male 9 7 70000 TRUE FALSE
## 8 AssocProf A Male 11 1 104800 TRUE FALSE
## 9 AssocProf A Male 45 39 70700 TRUE FALSE
## 10 AssocProf A Male 10 1 108413 TRUE FALSE
## 11 AssocProf A Male 11 8 104121 TRUE FALSE
## 12 AssocProf B Female 14 7 109650 TRUE TRUE
## 13 AssocProf B Female 12 9 71065 TRUE TRUE
## 14 AssocProf B Male 13 11 126431 TRUE FALSE
## 15 Prof A Male 29 7 204000 TRUE FALSE
## 16 Prof A Male 42 18 194800 TRUE FALSE
## 17 Prof A Male 43 43 205500 TRUE FALSE
## 18 Prof B Male 38 38 231545 TRUE FALSESalaries$salary[Salaries$salary%in%wartosci.odstajace$salary] <- NA
Salaries <- na.omit(Salaries)Ponieważ nie zostały spełnione założenia, logarytmujemy zmienną ‘salary’
Salaries <- mutate(Salaries,log=log10(salary))Sprawdzamy normalność po modyfikacji
Salaries %>%
group_by(rank,discipline,sex) %>%
shapiro_test(log) ## # A tibble: 12 x 6
## rank discipline sex variable statistic p
## <fct> <fct> <fct> <chr> <dbl> <dbl>
## 1 AsstProf A Female log 0.813 0.104
## 2 AsstProf A Male log 0.952 0.560
## 3 AsstProf B Female log 0.896 0.387
## 4 AsstProf B Male log 0.931 0.0218
## 5 AssocProf A Female log 0.978 0.717
## 6 AssocProf A Male log 0.891 0.0587
## 7 AssocProf B Female log 0.916 0.517
## 8 AssocProf B Male log 0.981 0.840
## 9 Prof A Female log 0.936 0.575
## 10 Prof A Male log 0.985 0.212
## 11 Prof B Female log 0.976 0.939
## 12 Prof B Male log 0.986 0.236Po modyfikacji tylko w 2 grupach P-value < 0.05, zatem możemy przyjąć, że rozkład jest normalny
Zobaczmy, jak wyglądają wykresy normalności wg podgrup:
ggqqplot(Salaries, "salary") +
facet_grid(sex~discipline~rank)
Anova - dlag rup nierównolicznych
anova_test(log~rank*discipline*sex, data=Salaries, type = 3)## Coefficient covariances computed by hccm()## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05
## 1 rank 2 366 74.804 0.000000000000000000000000000579 *
## 2 discipline 1 366 27.566 0.000000258000000000000007365636 *
## 3 sex 1 366 0.270 0.603999999999999981348253186297
## 4 rank:discipline 2 366 1.248 0.287999999999999978239628717347
## 5 rank:sex 2 366 0.114 0.893000000000000015987211554602
## 6 discipline:sex 1 366 0.635 0.425999999999999989785948173449
## 7 rank:discipline:sex 2 366 0.315 0.729999999999999982236431605997
## ges
## 1 0.290000
## 2 0.070000
## 3 0.000736
## 4 0.007000
## 5 0.000621
## 6 0.002000
## 7 0.002000Jak możemy zauważyć występują zależności pomiędzy zmiennymi ‘rank’ a ‘salaries’ oraz między zmiennymi ‘discipline’ a ‘salaries’ z osobna. Nie występują natomiast żadne interakcje oraz wspólne zależności pomiędzy zmiennymi a zamienną badaną.
Ancova
anova_test(log~yrs.since.phd*yrs.service+rank*discipline*sex, data=Salaries, type = 3)## Coefficient covariances computed by hccm()## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 yrs.since.phd 1 363 9.974 0.0020000000000 * 0.027
## 2 yrs.service 1 363 5.055 0.0250000000000 * 0.014
## 3 rank 2 363 26.136 0.0000000000249 * 0.126
## 4 discipline 1 363 28.508 0.0000001650000 * 0.073
## 5 sex 1 363 0.610 0.4350000000000 0.002
## 6 yrs.since.phd:yrs.service 1 363 15.060 0.0001240000000 * 0.040
## 7 rank:discipline 2 363 1.490 0.2270000000000 0.008
## 8 rank:sex 2 363 0.227 0.7970000000000 0.001
## 9 discipline:sex 1 363 0.445 0.5050000000000 0.001
## 10 rank:discipline:sex 2 363 0.524 0.5930000000000 0.003Lata od doktoratu i staż pracy mogą być istotnymi zmiennymi współoddziałującymi na płacę, ponadto występuje między nimi interakcja.
Manova
model <- lm(cbind(yrs.since.phd, yrs.service) ~ salary, Salaries)
Manova(model, test.statistic = "Pillai")##
## Type II MANOVA Tests: Pillai test statistic
## Df test stat approx F num Df den Df Pr(>F)
## salary 1 0.17091 38.65 2 375 0.0000000000000005474 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Stwierdzono statystycznie istotną różnicę pomiędzy wielkością wynagrodzenia na połączonych zmiennych (lata od doktoratu oraz lata służby), P-value < 0.05