Basic data analysis workshop - BTH (8-10/12/2023)

Ngày 2 (9/12/2023) - Hiển thị dữ liệu

Đọc dữ liệu vào R

salary = read.csv("C:\\Thach\\UTS\\Teaching\\TRM\\Practical Data Analysis\\2023_Spring semester\\Data\\Professorial Salaries.csv")
dim(salary)
## [1] 397   9

Việc 1. Biểu đồ phân bố (histogram)

1.1 Lương GS

library(ggplot2)
library(gridExtra) 

p = ggplot(data = salary, aes(x = Salary))

p1 = p + geom_histogram(color = "white", fill = "blue")

p2 = p + geom_histogram(aes(y = ..density..), color = "white", fill = "blue")
p2 = p2 + geom_density(col="red")

grid.arrange(p1, p2, ncol = 2)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

1.2 Lương giáo sư theo giới tính

p = ggplot(data = salary, aes(x = Salary, fill = Sex))
p1 = p + geom_histogram(position = "dodge") 

p2 = ggplot(data = salary, aes(x = Salary, fill = Sex, color = Sex)) + geom_density(alpha = 0.1)

grid.arrange(p1, p2, nrow = 2)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Việc 2. Biểu đồ thanh (bar plot)

2.1 Bậc GS

p = ggplot(data = salary, aes(x = Rank, fill = Rank, col = Rank))
p1 = p + geom_bar(position = "dodge")
p1

salary$rank.order = factor(salary$Rank, levels = c("AsstProf", "AssocProf", "Prof"))
p = ggplot(data = salary, aes(x = rank.order, fill = rank.order, col = rank.order))
p2 = p + geom_bar(position = "dodge")
p2

grid.arrange(p1, p2, nrow = 2)

2.2 Bậc GS theo giới tính

# Đơn giản:
p = ggplot(data = salary, aes(x = rank.order, fill = Sex, col = Sex))
p1 = p + geom_bar(position = "dodge")
p1

# Có phần trăm

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following object is masked from 'package:gridExtra':
## 
##     combine
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
p = ggplot(salary %>% count(rank.order, Sex) %>% mutate(pct = n/sum(n)), aes(factor(rank.order), n, fill = Sex))
p = p + geom_bar(stat ="identity")
p = p + geom_text(aes(label = paste0(sprintf("%1.1f", pct*100),"%")), position = position_stack(vjust=0.5))
p + labs(x = "Bậc GS", y = "Số trường hợp") + ggtitle("Bậc GS theo giới tính")

3. Biểu đồ hộp (box plot)

3.1 Tiền lương theo bậc GS

p = ggplot(data = salary, aes(x = rank.order, y = Salary, fill = rank.order))
p1 = p + geom_boxplot() + geom_jitter(alpha = 0.05) 
p1 + labs(x = "Bậc GS", y = "Tiền lương (USD)") + ggtitle("Tiền lương theo bậc GS") + theme_bw()

3.2 Tiền lương theo giới tính

p = ggplot(data = salary, aes(x = Sex, y = Salary, fill = Sex, col = Sex))
p1 = p + geom_boxplot(col = "black") + geom_jitter(alpha = 0.05) 
p1 + labs(x = "Giới tính", y = "Tiền lương (USD)") + ggtitle("Tiền lương theo giới tính")

3.3 Tiền lương theo bậc giáo sư và giới tính

p = ggplot(data = salary, aes(x = rank.order, y = Salary, fill = Sex, col = Sex))
p1 = p + geom_boxplot(col = "black") + geom_jitter(alpha = 0.05) 
p1 + labs(x = "Bậc GS", y = "Lương (USD)") + ggtitle("Lương theo bậc GS và giới tính") + theme_bw()

Việc 4. Biểu đồ tán xạ (scatter plot)

4.1 Mối liên quan giữa tiền lương và thời gian làm việc

p = ggplot(data = salary, aes(x = Yrs.service, y = Salary))
p1 = p + geom_point()
p1

p2 = p + geom_point() + geom_smooth() + labs(x = "Thời gian làm việc (năm)", y = "Lương (USD)") + ggtitle("Liên quan giữa tiền lương và thời gian làm việc") + theme_bw()
p2
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

4.2 Mối liên quan giữa tiền lương và thời gian làm việc theo giới tính

p = ggplot(data = salary, aes(x = Yrs.service, y = Salary, fill = Sex, col = Sex))
p1 = p + geom_point() + geom_smooth() + labs(x = "Thời gian làm việc (năm)", y = "Lương (USD)") + ggtitle("Liên quan giữa Lương và thời gian làm việc theo giới") + theme_bw()
p1
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

p2 = p + geom_point() + geom_smooth(method = "lm", formula = y ~ x + I(x^2) + I(x^3)) + labs(x = "Thời gian làm việc (năm)", y = "Lương (USD)") + ggtitle("Liên quan giữa lương và thời gian làm việc theo giới") + theme_bw()
p2

Việc 5. Lương có khác nhau giữa GS nam và GS nữ không?

library(table1)
## 
## Attaching package: 'table1'
## The following objects are masked from 'package:base':
## 
##     units, units<-
table1(~ Salary | Sex, data = salary)
Female
(N=39)		 Male
(N=358)		 Overall
(N=397)
Salary
Mean (SD) 101000 (26000) 115000 (30400) 114000 (30300)
Median [Min, Max] 104000 [62900, 161000] 108000 [57800, 232000] 107000 [57800, 232000] 
t.test(Salary ~ Sex, data = salary)
## 
##  Welch Two Sample t-test
## 
## data:  Salary by Sex
## t = -3.1615, df = 50.122, p-value = 0.002664
## alternative hypothesis: true difference in means between group Female and group Male is not equal to 0
## 95 percent confidence interval:
##  -23037.916  -5138.102
## sample estimates:
## mean in group Female   mean in group Male 
##             101002.4             115090.4

Việc 6. Lương các bậc GS có khác nhau không?

6.1 Lương các bậc GS có khác nhau không?

table1(~ Salary | Rank, data = salary)
AssocProf
(N=64)		 AsstProf
(N=67)		 Prof
(N=266)		 Overall
(N=397)
Salary
Mean (SD) 93900 (13800) 80800 (8170) 127000 (27700) 114000 (30300)
Median [Min, Max] 95600 [62900, 126000] 79800 [63100, 97000] 123000 [57800, 232000] 107000 [57800, 232000] 
anova = aov(Salary ~ Rank, data = salary)
summary(anova)
##              Df    Sum Sq   Mean Sq F value Pr(>F)    
## Rank          2 1.432e+11 7.162e+10   128.2 <2e-16 ***
## Residuals   394 2.201e+11 5.586e+08                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

6.3 Xác định các nhóm bậc GS có lương khác nhau

tukey.anova= TukeyHSD(anova)
tukey.anova
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Salary ~ Rank, data = salary)
## 
## $Rank
##                         diff       lwr       upr     p adj
## AsstProf-AssocProf -13100.45 -22818.71 -3382.195 0.0046514
## Prof-AssocProf      32895.67  25154.51 40636.836 0.0000000
## Prof-AsstProf       45996.12  38395.94 53596.307 0.0000000

Việc 7. Ghi lại lệnh và chia sẻ trên Rpubs (https://rpubs.com/ThachTran/1116791)