Salaries
Eryk Syldatk
31 01 2022
Zadanie Wczytaj zbiór danych Salaries z biblioteki carData i zapoznaj się z nim. Potraktuj zmienną salary jako odpowiedź a zmienne rank, discipline, sex jako zmienne wyjaśniające. Przy pomocy funkcji table sprawdź czy grupy są równoliczne. Wykonaj dwa wykresy skrzynkowe, jeden dla mężczyzn a drugi dla kobiet.
##Równoliczność
library(carData)
data("Salaries")
attach(Salaries)
salary1 <- Salaries[sex==c("male","female"),]## Warning in `==.default`(sex, c("male", "female")): długość dłuszego obiektu nie
## jest wielokrotnością długości krótszego obiektu## Warning in is.na(e1) | is.na(e2): długość dłuszego obiektu nie jest
## wielokrotnością długości krótszego obiektusalary1 <- Salaries[rank==c("Prof","AsstProf","AssocProf"),]## Warning in `==.default`(rank, c("Prof", "AsstProf", "AssocProf")): długość
## dłuszego obiektu nie jest wielokrotnością długości krótszego obiektu
## Warning in `==.default`(rank, c("Prof", "AsstProf", "AssocProf")): długość
## dłuszego obiektu nie jest wielokrotnością długości krótszego obiektusalary1 <- Salaries[discipline==c("A","B"),]## Warning in `==.default`(discipline, c("A", "B")): długość dłuszego obiektu nie
## jest wielokrotnością długości krótszego obiektu
## Warning in `==.default`(discipline, c("A", "B")): długość dłuszego obiektu nie
## jest wielokrotnością długości krótszego obiektuattach(salary1)## Następujące obiekty zostały zakryte z Salaries:
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phdtable(salary1$sex,salary1$rank,salary1$discipline)## , , = A
##
##
## AsstProf AssocProf Prof
## Female 1 2 4
## Male 12 10 63
##
## , , = B
##
##
## AsstProf AssocProf Prof
## Female 2 2 5
## Male 22 13 65Grupy nie są równoliczne.
##Wykresy Wykresy skrzynkowe dla obu grup:
attach(Salaries)## Następujące obiekty zostały zakryte z salary1:
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phd## Następujące obiekty zostały zakryte z Salaries (pos = 4):
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phdggplot(Salaries, aes(x = sex, y = salary, colour=rank)) + geom_boxplot() + ggtitle("Boxplot Rank and Salary") + theme(plot.title = element_text(hjust = 0.5),axis.title.x = element_text(color="blue", size=14, face="bold"),axis.title.y = element_text(color="blue", size=14, face="bold")) + xlab("Rank") + ylab("Salary") 
##Założenia: Zależność, normalność, wartości odstające
attach(Salaries)## Następujące obiekty zostały zakryte z Salaries (pos = 3):
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phd## Następujące obiekty zostały zakryte z salary1:
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phd## Następujące obiekty zostały zakryte z Salaries (pos = 5):
##
## discipline, rank, salary, sex, yrs.service, yrs.since.phdprop.test(table(Salaries[c(1,2)]))##
## 3-sample test for equality of proportions without continuity
## correction
##
## data: table(Salaries[c(1, 2)])
## X-squared = 4.6487, df = 2, p-value = 0.09785
## alternative hypothesis: two.sided
## sample estimates:
## prop 1 prop 2 prop 3
## 0.3582090 0.4062500 0.4924812prop.test(table(Salaries[c(1,5)]))##
## 3-sample test for equality of proportions without continuity
## correction
##
## data: table(Salaries[c(1, 5)])
## X-squared = 8.5259, df = 2, p-value = 0.01408
## alternative hypothesis: two.sided
## sample estimates:
## prop 1 prop 2 prop 3
## 0.16417910 0.15625000 0.06766917prop.test(table(Salaries[c(2,5)]))##
## 2-sample test for equality of proportions with continuity correction
##
## data: table(Salaries[c(2, 5)])
## X-squared = 2.7708e-30, df = 1, p-value = 1
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.05883604 0.06328663
## sample estimates:
## prop 1 prop 2
## 0.09944751 0.09722222Salaries %>%
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.0435wartosci_odstajace <- Salaries %>%
group_by(rank,discipline,sex) %>%
identify_outliers(salary)Zmienne są od siebie niezależne, rozkłady nie są normalne i istnieją wartości odstające.
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 Asst~ A Fema~ 7 6 63100 TRUE FALSE
## 2 Asst~ A Male 3 1 63900 TRUE FALSE
## 3 Asst~ A Male 2 0 85000 TRUE TRUE
## 4 Asst~ A Male 8 4 81035 TRUE FALSE
## 5 Asso~ A Fema~ 25 22 62884 TRUE FALSE
## 6 Asso~ A Male 14 8 100102 TRUE FALSE
## 7 Asso~ A Male 9 7 70000 TRUE FALSE
## 8 Asso~ A Male 11 1 104800 TRUE FALSE
## 9 Asso~ A Male 45 39 70700 TRUE FALSE
## 10 Asso~ A Male 10 1 108413 TRUE FALSE
## 11 Asso~ A Male 11 8 104121 TRUE FALSE
## 12 Asso~ B Fema~ 14 7 109650 TRUE TRUE
## 13 Asso~ B Fema~ 12 9 71065 TRUE TRUE
## 14 Asso~ 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 FALSElibrary(extraoperators)## Warning: pakiet 'extraoperators' został zbudowany w wersji R 4.1.2Salaries$salary[Salaries$salary%in%wartosci_odstajace$salary] <- NA
library(stats)
Salaries <- na.omit(Salaries)
Salaries <- mutate(Salaries,salary2=log10(salary))
Salaries %>%
group_by(rank,discipline,sex) %>%
shapiro_test(salary2)## # A tibble: 12 x 6
## rank discipline sex variable statistic p
## <fct> <fct> <fct> <chr> <dbl> <dbl>
## 1 AsstProf A Female salary2 0.813 0.104
## 2 AsstProf A Male salary2 0.952 0.560
## 3 AsstProf B Female salary2 0.896 0.387
## 4 AsstProf B Male salary2 0.931 0.0218
## 5 AssocProf A Female salary2 0.978 0.717
## 6 AssocProf A Male salary2 0.891 0.0587
## 7 AssocProf B Female salary2 0.916 0.517
## 8 AssocProf B Male salary2 0.981 0.840
## 9 Prof A Female salary2 0.936 0.575
## 10 Prof A Male salary2 0.985 0.212
## 11 Prof B Female salary2 0.976 0.939
## 12 Prof B Male salary2 0.986 0.236Po usunięciu wartości odstająych i wprowadzeniu nowej zmiennej (zlogarytmowanej zmiennej salary), rozkłady są normalne.
##Porównaj ze sobą wyniki trójczynnikowych analiz wariancji wykonanych bez interakcji oraz z interakcjami. Zinterpretuj wyniki.
Salaries %>%
anova_test(salary2~rank*discipline*sex)## Coefficient covariances computed by hccm()## ANOVA Table (type II tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 rank 2 366 189.135 3.89e-57 * 0.508000
## 2 discipline 1 366 57.685 2.59e-13 * 0.136000
## 3 sex 1 366 0.312 5.77e-01 0.000851
## 4 rank:discipline 2 366 1.527 2.19e-01 0.008000
## 5 rank:sex 2 366 0.089 9.15e-01 0.000486
## 6 discipline:sex 1 366 0.713 3.99e-01 0.002000
## 7 rank:discipline:sex 2 366 0.315 7.30e-01 0.002000Salaries %>%
tukey_hsd(salary2~rank)## # A tibble: 3 x 9
## term group1 group2 null.value estimate conf.low conf.high p.adj
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 rank AsstProf AssocProf 0 0.0620 0.0270 0.0971 0.000113
## 2 rank AsstProf Prof 0 0.182 0.155 0.208 0
## 3 rank AssocProf Prof 0 0.120 0.0915 0.148 0
## # ... with 1 more variable: p.adj.signif <chr>Salaries %>%
tukey_hsd(salary2~discipline)## # A tibble: 1 x 9
## term group1 group2 null.value estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 disc~ A B 0 0.0369 0.0152 0.0587 9.3e-4 ***Wartościej zmiennej salary 2 istotnie różnią się w zależności od zmiennych rank i discipline. Natomiast w zmiennych rank i discpline wszystkie grupy różnią sie od siebie istotnie.
##Czy lata od doktoratu (yrs.since.phd), staż pracy (yrs.service) mogą być istotnymi zmiennymi współ-oddziaływującymi na płacę (salary)? H0: nie są istotnymi zmiennymi współodziaływojącymi na płacę H1: są istotnymi zmiennymi współodziaływojącymi na płacę
Salaries %>%
cor_test(yrs.since.phd,salary,method="pearson")## # A tibble: 1 x 8
## var1 var2 cor statistic p conf.low conf.high method
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 yrs.since.phd salary 0.4 8.53 3.76e-16 0.314 0.484 PearsonSalaries %>%
cor_test(yrs.service,salary,method="pearson")## # A tibble: 1 x 8
## var1 var2 cor statistic p conf.low conf.high method
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 yrs.service salary 0.33 6.72 6.57e-11 0.235 0.415 PearsonObie zmienne są istotnymi zmiennymi współ-odziaływującymi na płacę.
##Czy istnieje istotna różnica w latach od doktoratu (yrs.since.phd) i stażu pracy (yrs.service) różnej rangi profesorów?
Salaries %>%
group_by(rank) %>%
cor_test(yrs.since.phd,yrs.service,method="pearson")## # A tibble: 3 x 9
## rank var1 var2 cor statistic p conf.low conf.high method
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 AsstProf yrs.sinc~ yrs.se~ 0.42 3.61 6.22e- 4 0.192 0.604 Pears~
## 2 AssocProf yrs.sinc~ yrs.se~ 0.92 17.1 4.88e-23 0.868 0.954 Pears~
## 3 Prof yrs.sinc~ yrs.se~ 0.85 26.1 1.36e-74 0.814 0.882 Pears~Zmienne są skorelowane, nie istnieje więc istotna różnica w latach od doktoratu i stażu pracy różnej rangi profesorów.