Phân tích dữ liệu định tính

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.3.1

## Warning: package 'ggplot2' was built under R version 4.3.1

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(epitools)
library(DescTools)

## Warning: package 'DescTools' was built under R version 4.3.1

library(ggplot2)
library(readxl)
library(caret)

## Warning: package 'caret' was built under R version 4.3.1

## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following objects are masked from 'package:DescTools':
## 
##     MAE, RMSE
## 
## The following object is masked from 'package:purrr':
## 
##     lift

library(lmtest)

## Warning: package 'lmtest' was built under R version 4.3.1

## Loading required package: zoo

## Warning: package 'zoo' was built under R version 4.3.1

## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(fBasics)

## Warning: package 'fBasics' was built under R version 4.3.1

dt <- read_excel("C:/HK2-2023/Phân tích dữ liệu định tính/btvn.xlsx")

1 Bài về nhà tuần 6

Chạy mô hình hồi quy cho biến định lượng trong câu 2, thực hiện các bài toán liên quan.

1.1 Mô hình hồi quy

mh <- lm(formula = dt$Salary ~ dt$Gender+dt$Age+dt$`Education Level`+dt$`Job Title`+dt$`Years of Experience`, data = dt)
summary(mh)

## 
## Call:
## lm(formula = dt$Salary ~ dt$Gender + dt$Age + dt$`Education Level` + 
##     dt$`Job Title` + dt$`Years of Experience`, data = dt)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -138903  -16165   -3200   14822   83569 
## 
## Coefficients:
##                                         Estimate Std. Error t value Pr(>|t|)
## (Intercept)                              78173.3     3460.8  22.588  < 2e-16
## dt$GenderMale                             5797.0      670.6   8.645  < 2e-16
## dt$Age                                   -1762.0      125.8 -14.010  < 2e-16
## dt$`Education Level`High School         -35526.2     1409.1 -25.213  < 2e-16
## dt$`Education Level`Master's Degree      13503.6     1077.5  12.533  < 2e-16
## dt$`Education Level`PhD                  29449.5     1233.8  23.869  < 2e-16
## dt$`Job Title`Digital Marketing Manager  15023.3     1719.3   8.738  < 2e-16
## dt$`Job Title`Event Coordinator          33864.7     1626.7  20.818  < 2e-16
## dt$`Job Title`Junior Financial Advisor   27656.6     1689.2  16.372  < 2e-16
## dt$`Job Title`Software Engineer          28513.4     1764.4  16.160  < 2e-16
## dt$`Job Title`Technical Recruiter        10548.9     1744.8   6.046 1.57e-09
## dt$`Years of Experience`                  7938.0      157.9  50.267  < 2e-16
##                                            
## (Intercept)                             ***
## dt$GenderMale                           ***
## dt$Age                                  ***
## dt$`Education Level`High School         ***
## dt$`Education Level`Master's Degree     ***
## dt$`Education Level`PhD                 ***
## dt$`Job Title`Digital Marketing Manager ***
## dt$`Job Title`Event Coordinator         ***
## dt$`Job Title`Junior Financial Advisor  ***
## dt$`Job Title`Software Engineer         ***
## dt$`Job Title`Technical Recruiter       ***
## dt$`Years of Experience`                ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 26500 on 6686 degrees of freedom
## Multiple R-squared:  0.7484, Adjusted R-squared:  0.748 
## F-statistic:  1808 on 11 and 6686 DF,  p-value: < 2.2e-16

Hệ số R-squared = 0,7484 cho biết các biến độc lập trong mô hình giải thích được 74,84% sự biến thiên của mức lương nhận được.

Các biến có ý nghĩa thống kê bao gồm: GenderMale, Age, Education Level High School, Education Level Master’s Degree, Education Level PhD, Job Title Digital Marketing Manager, Job Title Event Coordinator, Job Title Junior Financial Advisor, Job Title Software Engineer, Job Title Technical Recruiter, Years of Experience.

1.2 Kiểm định khuyết tật của mô hình

1.2.1 Kiểm định hiện tượng đa cộng tuyến

VIF(mh)

##                              GVIF Df GVIF^(1/(2*Df))
## dt$Gender                1.061810  1        1.030441
## dt$Age                   8.749150  1        2.957896
## dt$`Education Level`     3.191830  3        1.213407
## dt$`Job Title`           2.461579  5        1.094262
## dt$`Years of Experience` 8.734994  1        2.955502

Kết quả tính toán cho thấy hệ số VIF của các biến đều nhỏ hơn 10. Do đó, mô hình không bị đa cộng tuyến cao.

1.2.2 Kiểm định phương sai sai số thay đổi

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không có phương sai sai số thay đổi

• \(H_1\): Mô hình có phương sai sai số thay đổi

Xét thống kê:

bptest(mh)

## 
##  studentized Breusch-Pagan test
## 
## data:  mh
## BP = 1230.6, df = 11, p-value < 2.2e-16

Ta có p-value < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy mô hình có phương sai sai số thay đổi.

1.2.3 Kiểm định tự tương quan

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không có tự tương quan bậc 2

• \(H_1\): Mô hình có tự tương quan bậc 2

Xét thống kê:

Box.test(mh$residuals, lag = 2, type = "Ljung-Box")

## 
##  Box-Ljung test
## 
## data:  mh$residuals
## X-squared = 3161.8, df = 2, p-value < 2.2e-16

Ta có p-value < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy mô hình có tự tương quan bậc 2.

2 Bài về nhà tuần 4 và tuần 5

Phân tích thống kê mô tả của 2 biến phụ thuộc ở câu 2 với 5 biến còn lại trong câu 3, nhận xét về kết quả phân tích này.

Chạy mô hình hồi quy cho biến định tính trong câu 2, thực hiện các bài toán liên quan.

2.1 Phân tích 2 biến là Job Title và Gender

Với dữ liệu gốc, biến chức vụ công việc (Job Title) là biến định tính có 6 giá trị: Delivery Driver, Event Coordinator, Junior Financial Advisor, Software Engineer, Digital Marketing Manager, Technical Recruiter, nên tác giả đã đặt quy ước về việc chuyển biến Job Title như sau: Chuyên môn thấp (Delivery Driver, Event Coordinator, Junior Financial Advisor) và Chuyên môn cao (Software Engineer, Digital Marketing Manager, Technical Recruiter).

w <- data.frame(dt)
Congviec <- w %>% mutate(cv = case_when(dt$`Job Title` == "Delivery Driver" ~ 1, dt$`Job Title` == "Event Coordinator" ~ 1, dt$`Job Title` == "Junior Financial Advisor" ~ 1, dt$`Job Title` == "Software Engineer" ~ 3, dt$`Job Title` == "Digital Marketing Manager" ~ 3, dt$`Job Title` == "Technical Recruiter" ~ 3))
Congviec <- cut(Congviec$cv, breaks = c(0,2,4), labels=c("Chuyên môn thấp", "Chuyên môn cao"))
Gioitinh <- dt$Gender
table(Gioitinh,Congviec)

##         Congviec
## Gioitinh Chuyên môn thấp Chuyên môn cao
##   Female            1030           1988
##   Male              1481           2199

prop.table(table(Gioitinh,Congviec))

##         Congviec
## Gioitinh Chuyên môn thấp Chuyên môn cao
##   Female       0.1537772      0.2968050
##   Male         0.2211108      0.3283070

addmargins(table(Gioitinh,Congviec))

##         Congviec
## Gioitinh Chuyên môn thấp Chuyên môn cao  Sum
##   Female            1030           1988 3018
##   Male              1481           2199 3680
##   Sum               2511           4187 6698

ggplot(dt, aes(Congviec, fill = Gioitinh)) +  geom_bar(position = 'dodge')+ylab("Số lượng")+xlab("Chức vụ công việc")

Từ bảng tần số và đồ thị, ta thấy:

• Trong số 2511 người làm việc chuyên môn thấp có 1030 người là nữ (chiếm 15,38%) và 1481 người là nam (chiếm 22,11%).

• Trong số 4187 người làm việc chuyên môn cao có 1988 người là nữ (chiếm 29,68%) và 2199 người là nam (chiếm 32,83%).

Như vậy ở cả hai giới tính nam và nữ thì những người làm việc chuyên môn cao đều chiếm tỷ lệ cao hơn. Cho dù làm việc chuyên môn thấp hay chuyên môn cao thì tỷ lệ giới tính nam luôn cao hơn giới tính nữ.

Rủi ro tương đối

epitab(table(Gioitinh,Congviec),method = 'riskratio', rev = 'c')

## $tab
##         Congviec
## Gioitinh Chuyên môn cao        p0 Chuyên môn thấp        p1 riskratio    lower
##   Female           1988 0.6587144            1030 0.3412856  1.000000       NA
##   Male             2199 0.5975543            1481 0.4024457  1.179205 1.106876
##         Congviec
## Gioitinh    upper      p.value
##   Female       NA           NA
##   Male   1.256259 2.610728e-07
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ giữa những người giới tính nam làm việc chuyên môn thấp so với tỷ lệ giữa những người giới tính nữ làm việc chuyên môn thấp là 1,18.

Vậy rủi ro tương đối mẫu là 1,18 cho thấy tỷ lệ giữa những người làm việc chuyên môn thấp trong những người giới tính nam cao hơn 1,18 lần so với tỷ lệ những người giới tính nữ.

Với độ tin cậy 95% thì giá trị này cho biết tỷ lệ những người làm việc chuyên môn thấp trong những người giới tính nam cao hơn trong khoảng 1,11 lần đến 1,26 lần so với tỷ lệ những người giới tính nữ.

Tỉ lệ chênh

epitab(table(Gioitinh,Congviec), method = 'oddsratio', rev = 'c')

## $tab
##         Congviec
## Gioitinh Chuyên môn cao       p0 Chuyên môn thấp        p1 oddsratio   lower
##   Female           1988 0.474803            1030 0.4101951  1.000000      NA
##   Male             2199 0.525197            1481 0.5898049  1.299897 1.17618
##         Congviec
## Gioitinh    upper      p.value
##   Female       NA           NA
##   Male   1.436627 2.610728e-07
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ chuyên môn thấp so với chuyên môn cao của những người giới tính nữ gấp 1,3 lần tỷ lệ chuyên môn thấp so với chuyên môn cao của những người giới tính nam.

2.2 Phân tích 2 biến là Job Title và Age

Với dữ liệu gốc, biến độ tuổi (Age) là biến định lượng có giá trị trong khoảng 21 - 62, nên tác giả đã đặt quy ước về việc chuyển biến Age như sau: Dưới 40 tuổi (0 - 40) và Trên 40 tuổi (40 - 70).

Tuoi <- cut(dt$Age, breaks = c(0,40,70), labels = c("Dưới 40 tuổi", "Trên 40 tuổi"))
table(Tuoi,Congviec)

##               Congviec
## Tuoi           Chuyên môn thấp Chuyên môn cao
##   Dưới 40 tuổi            2357           2993
##   Trên 40 tuổi             154           1194

prop.table(table(Tuoi,Congviec))

##               Congviec
## Tuoi           Chuyên môn thấp Chuyên môn cao
##   Dưới 40 tuổi      0.35189609     0.44684981
##   Trên 40 tuổi      0.02299194     0.17826217

addmargins(table(Tuoi,Congviec))

##               Congviec
## Tuoi           Chuyên môn thấp Chuyên môn cao  Sum
##   Dưới 40 tuổi            2357           2993 5350
##   Trên 40 tuổi             154           1194 1348
##   Sum                     2511           4187 6698

ggplot(dt, aes(Congviec, fill = Tuoi)) +  geom_bar(position = 'dodge')+ylab("Số lượng")+xlab("Chức vụ công việc")

Từ bảng tần số và đồ thị, ta thấy:

• Trong số 2511 người làm việc chuyên môn thấp có 2357 người dưới 40 tuổi (chiếm 35,19%) và 154 người trên 40 tuổi (chiếm 2,3%).

• Trong số 4187 người làm việc chuyên môn cao có 2993 người dưới 40 tuổi (chiếm 44,68%) và 1194 người trên 40 tuổi (chiếm 17,83%).

Như vậy dù làm việc chuyên môn thấp hay chuyên môn cao thì người dưới 40 tuổi vẫn chiếm tỷ lệ cao hơn.

Rủi ro tương đối

epitab(table(Tuoi,Congviec),method = 'riskratio', rev = 'c')

## $tab
##               Congviec
## Tuoi           Chuyên môn cao        p0 Chuyên môn thấp        p1 riskratio
##   Dưới 40 tuổi           2993 0.5594393            2357 0.4405607 1.0000000
##   Trên 40 tuổi           1194 0.8857567             154 0.1142433 0.2593134
##               Congviec
## Tuoi               lower     upper       p.value
##   Dưới 40 tuổi        NA        NA            NA
##   Trên 40 tuổi 0.2228187 0.3017856 3.650612e-124
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ giữa những người trên 40 tuổi làm việc chuyên môn thấp so với tỷ lệ giữa những người dưới 40 tuổi làm việc chuyên môn thấp là 0,26.

Vậy rủi ro tương đối mẫu là 0,26 cho thấy tỷ lệ người làm việc chuyên môn thấp đối với những người trên 40 tuổi thấp hơn 74% so với những người dưới 40 tuổi.

Với độ tin cậy 95%, thì tỷ lệ những người làm việc chuyên môn thấp trên 40 tuổi ít hơn 69,82% đến 77,72% những người dưới 40 tuổi.

Tỉ lệ chênh

epitab(table(Tuoi,Congviec), method = 'oddsratio', rev = 'c')

## $tab
##               Congviec
## Tuoi           Chuyên môn cao        p0 Chuyên môn thấp         p1 oddsratio
##   Dưới 40 tuổi           2993 0.7148316            2357 0.93866985  1.000000
##   Trên 40 tuổi           1194 0.2851684             154 0.06133015  0.163781
##               Congviec
## Tuoi               lower     upper       p.value
##   Dưới 40 tuổi        NA        NA            NA
##   Trên 40 tuổi 0.1373111 0.1953537 3.650612e-124
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ chuyên môn thấp so với chuyên môn cao của những người dưới 40 tuổi bằng 16,38% tỷ lệ chuyên môn thấp so với chuyên môn cao của những người trên 40 tuổi.

2.3 Phân tích 2 biến là Salary và Education Level

Với dữ liệu gốc, biến mức lương (Salary) là biến định lượng có giá trị trong khoảng 350 - 250000, nên tác giả đã đặt quy ước về việc chuyển biến Salary như sau: Thấp (0 - 100000) và Cao (100000 - 260000). Biến tình trạng học vấn (Education Level) là biến định tính có 4 giá trị: Bachelor’s Degree, High School, Master’s Degree, PhD, nên tác giả đã đặt quy ước về việc chuyển biến Education Level như sau: Dưới đại học (Bachelor’s Degree, High School) và Trên đại học (Master’s Degree, PhD).

Hocvan <- w %>% mutate(hv = case_when(dt$`Education Level` == "Bachelor's Degree" ~ 1, dt$`Education Level` == "High School" ~ 1, dt$`Education Level` == "Master's Degree" ~ 3, dt$`Education Level` == "PhD" ~ 3))
Hocvan <- cut(Hocvan$hv, breaks = c(0,2,4), labels=c("Dưới đại học", "Trên đại học"))
Luong <- cut(dt$Salary, breaks = c(0,100000,260000), labels = c("Thấp", "Cao"))
table(Hocvan,Luong)

##               Luong
## Hocvan         Thấp  Cao
##   Dưới đại học 2380 1089
##   Trên đại học  546 2683

prop.table(table(Hocvan,Luong))

##               Luong
## Hocvan               Thấp        Cao
##   Dưới đại học 0.35532995 0.16258585
##   Trên đại học 0.08151687 0.40056733

addmargins(table(Hocvan,Luong))

##               Luong
## Hocvan         Thấp  Cao  Sum
##   Dưới đại học 2380 1089 3469
##   Trên đại học  546 2683 3229
##   Sum          2926 3772 6698

ggplot(dt, aes(Luong, fill = Hocvan)) +  geom_bar(position = 'dodge')+ylab("Số lượng")+xlab("Mức lương")

Từ bảng tần số và đồ thị, ta thấy:

• Trong số 2926 người lương thấp có 2380 người trình độ dưới đại học (chiếm 35,53%) và 546 người trên đại học (chiếm 8,15%).

• Trong số 3772 người lương cao có 1089 người dưới đại học (chiếm 16,26%) và 1194 người trên đại học (chiếm 40,06%).

Từ đồ thị ta thấy trong số những người lương thấp thì tỷ lệ người dưới đại học cao hơn tỷ lệ người trên đại học. Còn ở những người lương cao thì tỷ lệ người trên đại học cao hơn.

Rủi ro tương đối

epitab(table(Hocvan,Luong),method = 'riskratio', rev = 'c')

## $tab
##               Luong
## Hocvan          Cao        p0 Thấp        p1 riskratio     lower     upper
##   Dưới đại học 1089 0.3139233 2380 0.6860767 1.0000000        NA        NA
##   Trên đại học 2683 0.8309074  546 0.1690926 0.2464631 0.2275816 0.2669112
##               Luong
## Hocvan         p.value
##   Dưới đại học      NA
##   Trên đại học       0
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ giữa những người trên đại học có lương thấp so với tỷ lệ giữa những người dưới đại học có lương thấp là 0,25.

Vậy rủi ro tương đối mẫu là 0,25 cho thấy tỷ lệ lương thấp đối với những người trên đại học thấp hơn 75% so với những người dưới đại học.

Với độ tin cậy 95%, thì tỷ lệ lương thấp trong những người trên đại học ít hơn 73,31% đến 77,24% so với những người dưới đại học.

Tỉ lệ chênh

epitab(table(Hocvan,Luong), method = 'oddsratio', rev = 'c')

## $tab
##               Luong
## Hocvan          Cao        p0 Thấp        p1 oddsratio      lower     upper
##   Dưới đại học 1089 0.2887063 2380 0.8133971 1.0000000         NA        NA
##   Trên đại học 2683 0.7112937  546 0.1866029 0.0931157 0.08286272 0.1046373
##               Luong
## Hocvan         p.value
##   Dưới đại học      NA
##   Trên đại học       0
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ lương thấp so với lương cao của những người dưới đại học bằng 9,3% tỷ lệ lương thấp so với lương cao của những người trên đại học.

2.4 Phân tích 2 biến là Salary và Years of Experience

Với dữ liệu gốc, biến kinh nghiệm làm việc (Years of Experience) là biến định lượng có giá trị trong khoảng 0 - 34, nên tác giả đã đặt quy ước về việc chuyển biến Years of Experience như sau: Ít (0 - 10) và Nhiều (10 - 35).

Kinhnghiem <- cut(dt$`Years of Experience`, breaks = c(-1,10,35), labels = c("Ít", "Nhiều"))
table(Kinhnghiem,Luong)

##           Luong
## Kinhnghiem Thấp  Cao
##      Ít    2906 1687
##      Nhiều   20 2085

prop.table(table(Kinhnghiem,Luong))

##           Luong
## Kinhnghiem        Thấp         Cao
##      Ít    0.433860854 0.251866229
##      Nhiều 0.002985966 0.311286951

addmargins(table(Kinhnghiem,Luong))

##           Luong
## Kinhnghiem Thấp  Cao  Sum
##      Ít    2906 1687 4593
##      Nhiều   20 2085 2105
##      Sum   2926 3772 6698

ggplot(dt, aes(Luong, fill = Kinhnghiem)) +  geom_bar(position = 'dodge')+ylab("Số lượng")+xlab("Mức lương")

Từ bảng tần số và đồ thị, ta thấy:

• Trong số 2926 người lương thấp có 2906 người có ít kinh nghiệm làm việc (chiếm 43,39%) và 20 người nhiều kinh nghiệm làm việc (chiếm 0,3%).

• Trong số 3772 người lương cao có 1687 người ít kinh nghiệm làm việc (chiếm 25,19%) và 2105 người nhiều kinh nghiệm làm việc (chiếm 31,13%).

Từ đồ thị ta thấy trong số những người lương thấp thì tỷ lệ người ít kinh nghiệm làm việc cao hơn tỷ lệ người nhiều kinh nghiệm làm việc. Còn ở những người lương cao thì tỷ lệ người nhiều kinh nghiệm làm việc cao hơn.

Rủi ro tương đối

epitab(table(Kinhnghiem,Luong),method = 'riskratio', rev = 'c')

## $tab
##           Luong
## Kinhnghiem  Cao        p0 Thấp          p1  riskratio       lower      upper
##      Ít    1687 0.3672981 2906 0.632701938 1.00000000          NA         NA
##      Nhiều 2085 0.9904988   20 0.009501188 0.01501685 0.009703068 0.02324066
##           Luong
## Kinhnghiem p.value
##      Ít         NA
##      Nhiều       0
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ giữa những người nhiều kinh nghiệm làm việc có lương thấp so với tỷ lệ giữa những người ít kinh nghiệm làm việc có lương thấp là 0,02.

Vậy rủi ro tương đối mẫu là 0,02 cho thấy tỷ lệ lương thấp của những người nhiều kinh nghiệm làm việc thấp hơn 98% so với những người ít kinh nghiệm làm việc.

Với độ tin cậy 95%, thì tỷ lệ lương thấp của người nhiều kinh nghiệm làm việc ít hơn 97,77% đến 99,03% so với những người ít kinh nghiệm làm việc.

Tỉ lệ chênh

epitab(table(Kinhnghiem,Luong), method = 'oddsratio', rev = 'c')

## $tab
##           Luong
## Kinhnghiem  Cao        p0 Thấp         p1   oddsratio       lower       upper
##      Ít    1687 0.4472428 2906 0.99316473 1.000000000          NA          NA
##      Nhiều 2085 0.5527572   20 0.00683527 0.005568566 0.003570522 0.008684706
##           Luong
## Kinhnghiem p.value
##      Ít         NA
##      Nhiều       0
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Tỷ lệ lương thấp so với lương cao của những người ít kinh nghiệm làm việc bằng 0,56% tỷ lệ lương thấp so với lương cao của những nhiều kinh nghiệm làm việc.

2.5 Thống kê suy diễn cho dữ liệu định tính

2.5.1 Kiểm định tính độc lập cho hai biến định tính

Kiểm định tính độc lập cho hai biến Congviec và Gioitinh

Giả thuyết/Đối thuyết:

• \(H_0\): Biến Congviec và biến Gioitinh độc lập

• \(H_1\): Biến Congviec và biến Gioitinh không độc lập

Xét thống kê:

chisq.test(table(Congviec,Gioitinh))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(Congviec, Gioitinh)
## X-squared = 26.206, df = 1, p-value = 3.068e-07

Ta có p-value = 3,068e-07 < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy với mức ý nghĩa 5%, biến Congviec và biến Gioitinh không độc lập với nhau.

Kiểm định tính độc lập cho hai biến Congviec và Kinhnghiem

Giả thuyết/Đối thuyết:

• \(H_0\): Biến Congviec và biến Kinhnghiem độc lập

• \(H_1\): Biến Congviec và biến Kinhnghiem không độc lập

Xét thống kê:

chisq.test(table(Congviec,Kinhnghiem))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(Congviec, Kinhnghiem)
## X-squared = 735.04, df = 1, p-value < 2.2e-16

Ta có p-value = 2,2e-16 < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy với mức ý nghĩa 5%, biến Congviec và biến Kinhnghiem không độc lập với nhau.

Kiểm định tính độc lập cho hai biến Luong và Tuoi

Giả thuyết/Đối thuyết:

• \(H_0\): Biến Luong và biến Tuoi độc lập

• \(H_1\): Biến Luong và biến Tuoi không độc lập

Xét thống kê:

chisq.test(table(Luong,Tuoi))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(Luong, Tuoi)
## X-squared = 1271.6, df = 1, p-value < 2.2e-16

Ta có p-value = 2,2e-16 < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy với mức ý nghĩa 5%, biến Luong và biến Tuoi không độc lập với nhau.

Kiểm định tính độc lập cho hai biến Luong và Hocvan

Giả thuyết/Đối thuyết:

• \(H_0\): Biến Luong và biến Hocvan độc lập

• \(H_1\): Biến Luong và biến Hocvan không độc lập

Xét thống kê:

chisq.test(table(Luong,Hocvan))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(Luong, Hocvan)
## X-squared = 1814.8, df = 1, p-value < 2.2e-16

Ta có p-value = 2,2e-16 < 0,05 nên bác bỏ giả thuyết \(H_0\).

Vậy với mức ý nghĩa 5%, biến Luong và biến Hocvan không độc lập với nhau.

2.5.2 Khoảng ước lượng cho tỷ lệ

Ước lượng tỷ lệ người có lương cao

a <- dt[dt$Salary == 100000 | dt$Salary > 100000,]
prop.test(length(a$Salary == 100000 | a$Salary > 100000), length(dt$Salary))

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(a$Salary == 1e+05 | a$Salary > 1e+05) out of length(dt$Salary), null probability 0.5
## X-squared = 216.07, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.5779753 0.6016762
## sample estimates:
##         p 
## 0.5898776

Với độ tin cậy 95%, ước lượng tỷ lệ người có lương cao nằm trong khoảng từ 57,8% đến 60,17%.

Ước lượng sự chênh lệch về tỷ lệ người có ít kinh nghiệm làm việc giữa nam và nữ. Đồng thời thực hiện bài toán kiểm định sự chênh lệch này

gtm <- dt[dt$Gender == "Male",]
gtf <- dt[dt$Gender == "Female",]

gtm1 <- gtm[gtm$`Years of Experience` < 10,]
gtf1 <- gtf[gtf$`Years of Experience` < 10,]

x <- c(nrow(gtm), nrow(gtf))
z <- c(nrow(gtm1), nrow(gtf1))

prop.test(z,x)

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  z out of x
## X-squared = 39.502, df = 1, p-value = 3.277e-10
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.09653110 -0.05060637
## sample estimates:
##    prop 1    prop 2 
## 0.6239130 0.6974818

Ta có p-value > 0 nên bác bỏ giả thuyết \(H_0\), do đó không có sự chênh lệch về tỷ lệ người có ít kinh nghiệm làm việc giữa nam và nữ.

Khoảng tin cậy 95% cho chênh lệch tỷ lệ nằm trong khoảng từ -0,0965311 đến -0,05060637.

2.6 Ma trận hệ số Tương quan

continuous_vars <- dt[, sapply(dt, is.numeric)]
cor_matrix <- cor(continuous_vars)
cor_matrix

##                              ID        Age Years of Experience     Salary
## ID                   1.00000000 -0.1191793         -0.09868927 -0.3081368
## Age                 -0.11917925  1.0000000          0.93772531  0.7280606
## Years of Experience -0.09868927  0.9377253          1.00000000  0.8089682
## Salary              -0.30813680  0.7280606          0.80896817  1.0000000

Từ ma trận hệ số tương quan, ta thấy có mối tương quan mạnh giữa những cặp biến Age và Years of Experience, Age và Salary, Years of Experience và Salary.

2.7 Mô hình hồi quy

2.7.1 Mô hình logit

2.7.1.1 Mô hình 1

MH1 <- glm(factor(dt$`Job Title`)~dt$Gender+dt$Age+dt$Country+dt$Race+dt$`Education Level`+dt$`Years of Experience`+dt$Salary, family = binomial(link = "logit"), data = dt)
summary(MH1)

## 
## Call:
## glm(formula = factor(dt$`Job Title`) ~ dt$Gender + dt$Age + dt$Country + 
##     dt$Race + dt$`Education Level` + dt$`Years of Experience` + 
##     dt$Salary, family = binomial(link = "logit"), data = dt)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          1.183e+00  8.612e-01   1.374  0.16953    
## dt$GenderMale                       -1.778e-01  1.283e-01  -1.386  0.16579    
## dt$Age                              -9.116e-02  2.944e-02  -3.096  0.00196 ** 
## dt$CountryCanada                     2.380e-01  2.413e-01   0.986  0.32396    
## dt$CountryChina                      5.494e-02  3.022e-01   0.182  0.85577    
## dt$CountryUK                         1.359e-01  2.588e-01   0.525  0.59969    
## dt$CountryUSA                       -2.661e-03  2.452e-01  -0.011  0.99134    
## dt$RaceAsian                         8.126e-02  3.216e-01   0.253  0.80055    
## dt$RaceAustralian                    3.376e-01  4.229e-01   0.798  0.42472    
## dt$RaceBlack                        -2.916e-01  4.206e-01  -0.693  0.48823    
## dt$RaceChinese                       4.227e-01  4.686e-01   0.902  0.36703    
## dt$RaceHispanic                      3.028e-01  3.816e-01   0.793  0.42750    
## dt$RaceKorean                       -1.347e-01  4.546e-01  -0.296  0.76704    
## dt$RaceMixed                         1.273e-01  4.625e-01   0.275  0.78306    
## dt$RaceWelsh                         3.270e-01  4.743e-01   0.689  0.49056    
## dt$RaceWhite                        -3.393e-02  3.194e-01  -0.106  0.91540    
## dt$`Education Level`High School      2.790e+00  2.855e-01   9.770  < 2e-16 ***
## dt$`Education Level`Master's Degree  2.193e+00  2.841e-01   7.716 1.20e-14 ***
## dt$`Education Level`PhD              1.890e+01  3.889e+02   0.049  0.96123    
## dt$`Years of Experience`            -3.104e-01  4.402e-02  -7.053 1.75e-12 ***
## dt$Salary                            6.808e-05  4.846e-06  14.050  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2712.6  on 6697  degrees of freedom
## Residual deviance: 1887.1  on 6677  degrees of freedom
## AIC: 1929.1
## 
## Number of Fisher Scoring iterations: 19

Kiểm định sự phù hợp của mô hình

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không phù hợp

• \(H_1\): Mô hình phù hợp

lr_test <- anova(MH1, test = "Chisq")
p_value <- lr_test$Pr[2]
p_value

## [1] 0.2666465

Ta có p-value = 0,2666465 > 0,05 nên chưa đủ cơ sở bác bỏ giả thuyết \(H_0\). Vì vậy mô hình không phù hợp với dữ liệu.

2.7.1.2 Mô hình 2

Từ mô hình 1 ta thấy chỉ có các biến Age, Education Level, Years of Experience và Salary có ý nghĩa thống kê nên sử dụng để chạy mô hình 2.

MH2 <- glm(factor(dt$`Job Title`)~dt$Age+dt$`Education Level`+dt$`Years of Experience`+dt$Salary, family = binomial(link = "logit"), data = dt)
summary(MH2)

## 
## Call:
## glm(formula = factor(dt$`Job Title`) ~ dt$Age + dt$`Education Level` + 
##     dt$`Years of Experience` + dt$Salary, family = binomial(link = "logit"), 
##     data = dt)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          1.338e+00  7.901e-01   1.693   0.0905 .  
## dt$Age                              -9.122e-02  2.937e-02  -3.106   0.0019 ** 
## dt$`Education Level`High School      2.758e+00  2.831e-01   9.743  < 2e-16 ***
## dt$`Education Level`Master's Degree  2.235e+00  2.812e-01   7.949 1.87e-15 ***
## dt$`Education Level`PhD              1.889e+01  3.908e+02   0.048   0.9614    
## dt$`Years of Experience`            -3.019e-01  4.336e-02  -6.963 3.34e-12 ***
## dt$Salary                            6.608e-05  4.627e-06  14.281  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2712.6  on 6697  degrees of freedom
## Residual deviance: 1897.3  on 6691  degrees of freedom
## AIC: 1911.3
## 
## Number of Fisher Scoring iterations: 19

Kiểm định sự phù hợp của mô hình

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không phù hợp

• \(H_1\): Mô hình phù hợp

lr_test <- anova(MH2, test = "Chisq")
p_value <- lr_test$Pr[2]
p_value

## [1] 1.725049e-07

Ta có p-value = 1,725049e-07 < 0,05 nên bác bỏ giả thuyết \(H_0\). Vì vậy mô hình phù hợp với dữ liệu.

BrierScore

BrierScore(MH2)

## [1] 0.03975666

Ma trận nhầm lẫn

h <- predict(MH2, type = "response")
j <- ifelse(h > 0.5, "1", "0")
k <- factor(j, levels = c("0","1"))
l <- factor(Congviec, labels = c("0","1"))
confusionMatrix(table(k,l))

## Confusion Matrix and Statistics
## 
##    l
## k      0    1
##   0   29    5
##   1 2482 4182
##                                          
##                Accuracy : 0.6287         
##                  95% CI : (0.617, 0.6403)
##     No Information Rate : 0.6251         
##     P-Value [Acc > NIR] : 0.2768         
##                                          
##                   Kappa : 0.0129         
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.011549       
##             Specificity : 0.998806       
##          Pos Pred Value : 0.852941       
##          Neg Pred Value : 0.627551       
##              Prevalence : 0.374888       
##          Detection Rate : 0.004330       
##    Detection Prevalence : 0.005076       
##       Balanced Accuracy : 0.505178       
##                                          
##        'Positive' Class : 0              
## 

MH2 có độ chính xác toàn thể là 62,87%, độ nhạy là 1,15% và độ hiệu quả là 99,88%.

2.7.2 Mô hình hồi quy probit

MH3 <- glm(factor(dt$`Job Title`)~dt$Age+dt$`Education Level`+dt$`Years of Experience`+dt$Salary, family = binomial(link = "probit"), data = dt)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(MH3)

## 
## Call:
## glm(formula = factor(dt$`Job Title`) ~ dt$Age + dt$`Education Level` + 
##     dt$`Years of Experience` + dt$Salary, family = binomial(link = "probit"), 
##     data = dt)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          9.160e-01  4.091e-01   2.239  0.02516 *  
## dt$Age                              -4.571e-02  1.534e-02  -2.980  0.00288 ** 
## dt$`Education Level`High School      1.216e+00  1.236e-01   9.832  < 2e-16 ***
## dt$`Education Level`Master's Degree  1.064e+00  1.192e-01   8.923  < 2e-16 ***
## dt$`Education Level`PhD              7.020e+00  7.049e+01   0.100  0.92068    
## dt$`Years of Experience`            -1.514e-01  2.230e-02  -6.792 1.11e-11 ***
## dt$Salary                            3.179e-05  2.271e-06  13.999  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2712.6  on 6697  degrees of freedom
## Residual deviance: 1912.0  on 6691  degrees of freedom
## AIC: 1926
## 
## Number of Fisher Scoring iterations: 19

Kiểm định sự phù hợp của mô hình

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không phù hợp

• \(H_1\): Mô hình phù hợp

lr_test <- anova(MH3, test = "Chisq")

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

p_value <- lr_test$Pr[2]
p_value

## [1] 1.197276e-07

Ta có p-value = 1,197276e-07 < 0,05 nên bác bỏ giả thuyết \(H_0\). Vì vậy mô hình phù hợp với dữ liệu.

BrierScore

BrierScore(MH3)

## [1] 0.04013739

Ma trận nhầm lẫn

h <- predict(MH3, type = "response")
j <- ifelse(h > 0.5, "1", "0")
k <- factor(j, levels = c("0","1"))
l <- factor(Congviec, labels = c("0","1"))
confusionMatrix(table(k,l))

## Confusion Matrix and Statistics
## 
##    l
## k      0    1
##   0   19    5
##   1 2492 4182
##                                           
##                Accuracy : 0.6272          
##                  95% CI : (0.6155, 0.6388)
##     No Information Rate : 0.6251          
##     P-Value [Acc > NIR] : 0.367           
##                                           
##                   Kappa : 0.0079          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.007567        
##             Specificity : 0.998806        
##          Pos Pred Value : 0.791667        
##          Neg Pred Value : 0.626611        
##              Prevalence : 0.374888        
##          Detection Rate : 0.002837        
##    Detection Prevalence : 0.003583        
##       Balanced Accuracy : 0.503186        
##                                           
##        'Positive' Class : 0               
## 

MH3 có độ chính xác toàn thể là 62,72%, độ nhạy là 0,76% và độ hiệu quả là 99,88%.

2.7.3 Mô hình hồi quy cloglog

MH4 <- glm(factor(dt$`Job Title`)~dt$Age+dt$`Education Level`+dt$`Years of Experience`+dt$Salary, family = binomial(link = "cloglog"), data = dt)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(MH4)

## 
## Call:
## glm(formula = factor(dt$`Job Title`) ~ dt$Age + dt$`Education Level` + 
##     dt$`Years of Experience` + dt$Salary, family = binomial(link = "cloglog"), 
##     data = dt)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          5.381e-01  3.144e-01   1.712   0.0870 .  
## dt$Age                              -3.012e-02  1.189e-02  -2.532   0.0113 *  
## dt$`Education Level`High School      7.689e-01  8.618e-02   8.922  < 2e-16 ***
## dt$`Education Level`Master's Degree  7.708e-01  7.983e-02   9.657  < 2e-16 ***
## dt$`Education Level`PhD              4.613e+00  3.088e+01   0.149   0.8813    
## dt$`Years of Experience`            -1.186e-01  1.770e-02  -6.701 2.08e-11 ***
## dt$Salary                            2.256e-05  1.731e-06  13.033  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2712.6  on 6697  degrees of freedom
## Residual deviance: 1932.9  on 6691  degrees of freedom
## AIC: 1946.9
## 
## Number of Fisher Scoring iterations: 20

Kiểm định sự phù hợp của mô hình

Giả thuyết/Đối thuyết:

• \(H_0\): Mô hình không phù hợp

• \(H_1\): Mô hình phù hợp

lr_test <- anova(MH4, test = "Chisq")

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

p_value <- lr_test$Pr[2]
p_value

## [1] 8.819132e-08

Ta có p-value = 8,819132e-08 < 0,05 nên bác bỏ giả thuyết \(H_0\). Vì vậy mô hình phù hợp với dữ liệu.

BrierScore

BrierScore(MH4)

## [1] 0.04077284

Ma trận nhầm lẫn

h <- predict(MH4, type = "response")
j <- ifelse(h > 0.5, "1", "0")
k <- factor(j, levels = c("0","1"))
l <- factor(Congviec, labels = c("0","1"))
confusionMatrix(table(k,l))

## Confusion Matrix and Statistics
## 
##    l
## k      0    1
##   0   15    4
##   1 2496 4183
##                                          
##                Accuracy : 0.6268         
##                  95% CI : (0.615, 0.6384)
##     No Information Rate : 0.6251         
##     P-Value [Acc > NIR] : 0.3959         
##                                          
##                   Kappa : 0.0063         
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.005974       
##             Specificity : 0.999045       
##          Pos Pred Value : 0.789474       
##          Neg Pred Value : 0.626291       
##              Prevalence : 0.374888       
##          Detection Rate : 0.002239       
##    Detection Prevalence : 0.002837       
##       Balanced Accuracy : 0.502509       
##                                          
##        'Positive' Class : 0              
## 

MH4 có độ chính xác toàn thể là 62,68%, độ nhạy là 0,6% và độ hiệu quả là 99,9%.

2.7.4 Lựa chọn mô hình phù hợp

Môhình <- c("Logit","Probit","Cloglog","Lựa chọn")
AIC <- c(1911.3,1926,1946.9,"Logit")
Deviance <- c(1897.0,1912.0,1932.9,"Logit")
BrierScore <- c(0.03975666,0.04013739,0.04077284,"Logit")
ConfusionMatrix <- c(0.6287,0.6272,0.6268,"Logit")
bang <- data.frame(Môhình,AIC,Deviance,BrierScore,ConfusionMatrix)
bang

Dựa vào bảng kết quả của 3 mô hình, thông qua các chỉ số AIC, Deviance, BrierScore và ConfusionMatrix đều chỉ ra mô hình logit là tốt nhất. Do đó, mô hình logit được lựa chọn để phân tích các yếu tố tác động chức vụ công việc của người được khảo sát.

2.8 Kết quả của mô hình logit

summary(MH2)

## 
## Call:
## glm(formula = factor(dt$`Job Title`) ~ dt$Age + dt$`Education Level` + 
##     dt$`Years of Experience` + dt$Salary, family = binomial(link = "logit"), 
##     data = dt)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          1.338e+00  7.901e-01   1.693   0.0905 .  
## dt$Age                              -9.122e-02  2.937e-02  -3.106   0.0019 ** 
## dt$`Education Level`High School      2.758e+00  2.831e-01   9.743  < 2e-16 ***
## dt$`Education Level`Master's Degree  2.235e+00  2.812e-01   7.949 1.87e-15 ***
## dt$`Education Level`PhD              1.889e+01  3.908e+02   0.048   0.9614    
## dt$`Years of Experience`            -3.019e-01  4.336e-02  -6.963 3.34e-12 ***
## dt$Salary                            6.608e-05  4.627e-06  14.281  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2712.6  on 6697  degrees of freedom
## Residual deviance: 1897.3  on 6691  degrees of freedom
## AIC: 1911.3
## 
## Number of Fisher Scoring iterations: 19

2.8.1 Giải thích kết quả

Kết quả phân tích hồi quy Logit cho thấy có 4 biến độc lập có ý nghĩa thống kê bao gồm:

• Age: Độ tuổi của người khảo sát.

• Education Level: Trình độ học vấn.

• Years of Experience: Kinh nghiệm làm việc.

• Salary: Mức lương nhận được.

Với giả thuyết các yếu tố khác không đổi, tác động của từng biến được diễn giải như sau:

• Ở mức ý nghĩa 1%, độ tuổi có tác động tiêu cực đến quyết định chức vụ công việc.

• Ở mức ý nghĩa 1%, trình độ học vấn có tác động tích cực đến chức vụ công việc.

• Ở mức ý nghĩa 1%, kinh nghiệm làm việc có tác động tiêu cực đến chức vụ công việc.

• Ở mức ý nghĩa 1%, mức lương có tác động tích cực đến chức vụ công việc.

2.8.2 Khoảng ước lượng cho hệ số hồi quy

confint.default(MH2)

##                                             2.5 %        97.5 %
## (Intercept)                         -2.109816e-01  2.886001e+00
## dt$Age                              -1.487886e-01 -3.365034e-02
## dt$`Education Level`High School      2.203449e+00  3.313229e+00
## dt$`Education Level`Master's Degree  1.684133e+00  2.786337e+00
## dt$`Education Level`PhD             -7.471254e+02  7.849134e+02
## dt$`Years of Experience`            -3.868599e-01 -2.169029e-01
## dt$Salary                            5.701135e-05  7.514998e-05

2.8.3 Dự báo

pr <- predict(MH2,type = "response")
head(round(pr,4),10)

##      1      2      3      4      5      6      7      8      9     10 
## 0.9456 0.9880 1.0000 0.4763 0.9975 0.8485 0.9829 0.9301 0.8372 1.0000

3 Bài về nhà tuần 3

Làm thống kê mô tả cho ít nhất 7 biến (vừa định tính định lượng và có 2 biến đã chọn ở câu 2) nhận xét về kết quả phân tích này.

3.1 Biến Gender

table(dt$Gender)

## 
## Female   Male 
##   3018   3680

table(dt$Gender)/sum(table(dt$Gender))

## 
##    Female      Male 
## 0.4505823 0.5494177

ggplot(dt,aes(Gender))+geom_bar(color = "red",fill = "pink")+ geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', vjust = - .5)+xlab("Giới tính của người được khảo sát")+ylab("Số lượng")+theme_classic()

Biến Gender là biến định tính, theo thống kê ghi nhận được:

• Có 3018 người là nữ (chiếm 45,06%).

• Có 3680 người là nam (chiếm 54,94%).

Từ đồ thị thấy được khảo sát không có sự chênh lệch đáng kể về giới tính, tỷ lệ giới tính nam chỉ cao hơn khoảng 10% so với giới tính nữ.

3.2 Biến Country

table(dt$Country)

## 
## Australia    Canada     China        UK       USA 
##      1336      1325      1343      1335      1359

table(dt$Country)/sum(table(dt$Country))

## 
## Australia    Canada     China        UK       USA 
## 0.1994625 0.1978202 0.2005076 0.1993132 0.2028964

ggplot(dt,aes(Country))+geom_bar(color = "red",fill = "pink")+ geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', vjust = - .5)+xlab("Quốc gia của người được khảo sát")+ylab("Số lượng")+theme_classic()

Biến Country là biến định tính, theo kết quả thu thập được có:

• 1336 người ở Úc, chiếm 19,95%.

• 1325 người ở Canada, chiếm 19,78%.

• 1343 người ở Trung Quốc, chiếm 20,05%

• 1335 người ở Vương Quốc Anh, chiếm 19,93%.

• 1359 người ở Hoa Kỳ, chiếm 20,29%.

Từ đồ thị thấy được không có sự chênh lệch đáng kể về tỷ lệ quốc gia giữa những người được khảo sát.

3.3 Biến Race

table(dt$Race)

## 
## African American            Asian       Australian            Black 
##              354             1603              452              437 
##          Chinese         Hispanic           Korean            Mixed 
##              444              322              457              334 
##            Welsh            White 
##              333             1962

table(dt$Race)/sum(table(dt$Race))

## 
## African American            Asian       Australian            Black 
##       0.05285160       0.23932517       0.06748283       0.06524336 
##          Chinese         Hispanic           Korean            Mixed 
##       0.06628844       0.04807405       0.06822932       0.04986563 
##            Welsh            White 
##       0.04971633       0.29292326

pie(table(dt$Race), col = rainbow(10), main = "Biểu đồ tròn về chủng tộc")

Biến Race là biến định tính, theo kết quả thu thập được có:

• 354 người Mỹ gốc Phi, chiếm 5,29%.

• 1603 người Châu Á, chiếm 23,93%.

• 452 người Úc, chiếm 6,75%

• 437 người da đen, chiếm 6,52%.

• 444 người Trung Quốc, chiếm 6,63%.

• 322 người Tây Ban Nha, chiếm 4,81%.

• 457 người Hàn Quốc, chiếm 6,82%.

• 334 người chủng tộc hỗn hợp, chiếm 4,99%.

• 333 người Xứ Wales, chiếm 4,97%.

• 1962 người da trắng, chiếm 29,29%

Từ đồ thị thấy được tỷ lệ người da trắng là cao nhất với 29,29%.

3.4 Biến Education Level

table(dt$`Education Level`)

## 
## Bachelor's Degree       High School   Master's Degree               PhD 
##              3021               448              1860              1369

table(dt$`Education Level`)/sum(table(dt$`Education Level`))

## 
## Bachelor's Degree       High School   Master's Degree               PhD 
##        0.45103016        0.06688564        0.27769483        0.20438937

ggplot(dt,aes(`Education Level`))+geom_bar(color = "red",fill = "pink")+ geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', vjust = - .5)+xlab("Trình độ học vấn")+ylab("Số lượng")+theme_classic()

Biến Education Level là biến định tính, theo kết quả thu thập được có:

• 3021 người có bằng cử nhân, chiếm 45,1%.

• 448 người có bằng trung học, chiếm 6,69%.

• 1860 người có bằng thạc sĩ, chiếm 27,77%

• 1369 người có bằng tiến sĩ, chiếm 20,44%.

Từ đồ thị thấy được trong những người được khảo sát thì người có bằng cử nhân chiếm tỷ lệ cao nhất với 45,1%.

3.5 Biến Job Title

table(dt$`Job Title`)

## 
##           Delivery Driver Digital Marketing Manager         Event Coordinator 
##                       344                      1792                      1201 
##  Junior Financial Advisor         Software Engineer       Technical Recruiter 
##                       966                      1383                      1012

table(dt$`Job Title`)/sum(table(dt$`Job Title`))

## 
##           Delivery Driver Digital Marketing Manager         Event Coordinator 
##                0.05135861                0.26754255                0.17930726 
##  Junior Financial Advisor         Software Engineer       Technical Recruiter 
##                0.14422216                0.20647955                0.15108988

ggplot(dt,aes(`Job Title`))+geom_bar(color = "red",fill = "pink")+ geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', vjust = - .5)+xlab("Chức vụ công việc")+ylab("Số lượng")+theme_classic()

Biến Job Title là biến định tính, theo kết quả thu thập được có:

• 344 người làm tài xế giao hàng, chiếm 5,14%.

• 1792 người làm giám đốc tiếp thị kỹ thuật số, chiếm 26,75%.

• 1201 người làm điều phối viên sự kiện, chiếm 17,93%

• 966 người làm cố vấn tài chính, chiếm 14,42%.

• 1383 người làm kỹ sư phần mềm, chiếm 20,65%.

• 1012 người làm kỹ thuật viên, chiếm 15,11%.

Từ đồ thị thấy được trong những người được khảo sát thì người làm giám đốc tiếp thị kỹ thuật số chiếm tỷ lệ cao nhất với 26,75%.

3.6 Biến Age

summary(dt$Age)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   21.00   28.00   32.00   33.62   38.00   62.00

Biến Age là biến định lượng, từ kết quả thống kê ta thấy:

• Độ tuổi trung bình là 33,62.

• Độ tuổi thấp nhất là 21.

• Độ tuổi cao nhất là 62.

• Có 25% số người dưới 28 tuổi.

• Có 50% số người dưới 32 tuổi.

• Có 75% số người dưới 38 tuổi.

hist(dt$Age, col = "pink", main = "Biểu đồ độ tuổi", xlab = "Độ tuổi của người khảo sát", ylab = "Số lượng")

Từ biểu đồ thấy được độ tuổi của người khảo sát nhiều nhất là trong khoảng 25 - 35 tuổi.

3.7 Biến Years of Experience

summary(dt$`Years of Experience`)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   7.000   8.095  12.000  34.000

Biến Years of Experience là biến định lượng, từ kết quả thống kê ta thấy:

• Kinh nghiệm làm việc trung bình là 8,095.

• Kinh nghiệm làm việc thấp nhất là 0.

• Kinh nghiệm làm việc cao nhất là 34.

• Có 25% số người có dưới 3 năm kinh nghiệm làm việc.

• Có 50% số người có dưới 7 năm kinh nghiệm làm việc.

• Có 75% số người có dưới 12 năm kinh nghiệm làm việc.

hist(dt$`Years of Experience`, col = "pink", main = "Biểu đồ kinh nghiệm làm việc", xlab = "Kinh nghiệm làm việc của người khảo sát", ylab = "Số lượng")

Từ biểu đồ thấy được kinh nghiệm làm việc của người khảo sát nhiều nhất là dưới 10 năm.

3.8 Biến Salary

summary(dt$Salary)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     350   70000  115000  115329  160000  250000

Biến Salary là biến định lượng, từ kết quả thống kê ta thấy:

• Mức lương trung bình là 11532.

• Mức lương thấp nhất là 350.

• Mức lương cao nhất là 250000.

• Có 25% số người có mức lương dưới 7000.

• Có 50% số người có mức lương dưới 115000.

• Có 75% số người có mức lương dưới 160000.

hist(dt$Salary, col = "pink", main = "Biểu đồ mức lương", xlab = "Mức lương của người khảo sát", ylab = "Số lượng")

Từ biểu đồ thấy được mức lương của người khảo sát khá đồng đều và nằm trong khoảng từ 50000 - 200000 là nhiều nhất.

4 Bài về nhà tuần 2

Chọn 1 biến định tính và 1 biến định lượng làm biến phụ thuộc để phân tích, giải thích lý do.

4.1 Phân loại các biến trong dữ liệu

4.1.1 Dữ liệu định tính

• Gender: Giới tính (Male: Nam, Female: Nữ)

• Country: Quốc gia của người được khảo sát (Australia: Úc, Canada: Canada, China: Trung Quốc, UK: Vương Quốc Anh, USA: Hoa Kỳ)

• Race: Chủng tộc của người được khảo sát (African American: Người Mỹ gốc Phi, Asian: Người Châu Á, Australian: Người Úc, Black: Người da đen, Chinese: Người Trung Quốc, Hispanic: Người Tây Ban Nha, Korean: Người Hàn Quốc, Mixed: Người chủng tộc hỗn hợp, Welsh: Người Xứ Wales, White: Người da trắng)

• Education Level: Trình độ học vấn (High School: Có bằng trung học, Bachelor’Degree: Có bằng Cử nhân, Master’Degree: Có bằng Thạc Sĩ, PhD: Có bằng Tiến Sĩ)

• Job Title: Chức vụ công việc (Delivery driver: Tài xế giao hàng, Digital Marketing Manager: Giám đốc Tiếp thị kỹ thuật số, Event Coordinator: Điều phối viên sự kiện, Junior Financial Advisor: Cố vấn tài chính, Software Engineer: Kỹ sư phần mềm, Technical Recruiter: Kỹ thuật viên)

4.1.2 Dữ liệu định lượng

• ID: Số thứ tự của người được khảo sát của người được khảo sát

• Age: Độ tuổi (tính theo năm)

• Years of Experience: Kinh nghiệm làm việc

• Salary: Mức lương nhận được

4.2 Chọn biến phụ thuộc

4.2.1 Chọn biến định tính làm biến phụ thuộc

Phân tích các yếu tố ảnh hưởng đến chức vụ công việc (Job Title).

Chức vụ công việc có thể sẽ bị ảnh hưởng bởi các yếu tố như giới tính (Gender), trình độ học vấn (Education Level), độ tuổi (Age), kinh nghiệm làm việc (Years of Experience),… Do đó, chọn phân tích biến Job Title để phần nào giúp cho các nhà nghiên cứu hiểu sâu hơn về các biến, phục vụ cho công tác nghiên cứu đạt được kết quả tốt.

4.2.2 Chọn biến định lượng làm biến phụ thuộc

Phân tích các yếu tố ảnh hưởng đến mức lương của người được khảo sát (Salary).

Phân tích để xem xét mức lương có bị ảnh hưởng bởi các yếu tố: giới tính (Gender), trình độ học vấn (Education Level), độ tuổi (Age), kinh nghiệm làm việc (Years of Experience),… Do đó, chọn phân tích biến Salary để phần nào giúp cho các nhà nghiên cứu hiểu sâu hơn về các biến, phục vụ cho công tác nghiên cứu đạt được kết quả tốt.

5 Bài về nhà tuần 1

Tìm một dataset có dữ liệu định tính, có dữ liệu định lượng, có trên 5 biến và nhiều hơn 150 quan sát.

5.1 Dữ liệu nghiên cứu

Bộ dữ liệu bao gồm một bộ sưu tập toàn diện về lương và thông tin nhân khẩu học với các chi tiết bổ sung về số năm kinh nghiệm. Nó cung cấp một nguồn tài nguyên quý giá để nghiên cứu mối quan hệ giữa thu nhập và các yếu tố nhân khẩu xã hội khác nhau. Các thuộc tính nhân khẩu học bao gồm tuổi tác, giới tính, giáo dục, quốc gia và chủng tộc, cung cấp nhiều biến số khác nhau để phân tích. Các nhà nghiên cứu có thể khám phá các mô hình và xu hướng phân phối thu nhập trên các danh mục nhân khẩu học khác nhau, cho phép hiểu rõ hơn về sự chênh lệch tiềm năng hoặc các biến thể trong khả năng kiếm tiền. Hơn nữa, bộ dữ liệu kết hợp khía cạnh quan trọng của số năm kinh nghiệm, cho phép điều tra tác động của nhiệm kỳ chuyên môn đối với mức lương. Khía cạnh này bổ sung một khía cạnh năng động cho phân tích, cho phép các nhà nghiên cứu kiểm tra thu nhập thay đổi như thế nào dựa trên cả đặc điểm nhân khẩu học và kinh nghiệm làm việc tích lũy. Bộ dữ liệu mang đến cơ hội phong phú để thực hiện các nghiên cứu toàn diện về đa dạng thu nhập và hiểu các yếu tố nhiều mặt ảnh hưởng đến tiềm năng kiếm tiền trong lực lượng lao động ngày nay.

Bộ dữ liệu được thu thập từ Kaggle và mới được cập nhất gần đây vào tháng 06/2023.

5.2 Giải thích các biến

Bộ dữ liệu có 9 biến bao gồm 6698 quan sát có 4 biến định lượng và 5 biến định tính.

• ID: Số thứ tự của người được khảo sát

• Gender: Giới tính (Male: Nam, Female: Nữ)

• Age: Độ tuổi (tính theo năm)

• Country: Quốc gia của người được khảo sát (Australia: Úc, Canada: Canada, China: Trung Quốc, UK: Vương Quốc Anh, USA: Hoa Kỳ)

• Race: Chủng tộc của người được khảo sát (African American: Người Mỹ gốc Phi, Asian: Người Châu Á, Australian: Người Úc, Black: Người da đen, Chinese: Người Trung Quốc, Hispanic: Người Tây Ban Nha, Korean: Người Hàn Quốc, Mixed: Người chủng tộc hỗn hợp, Welsh: Người Xứ Wales, White: Người da trắng)

• Education Level: Trình độ học vấn (High School: Có bằng trung học, Bachelor’Degree: Có bằng Cử nhân, Master’Degree: Có bằng Thạc Sĩ, PhD: Có bằng Tiến Sĩ)

• Job Title: Chức vụ công việc (Delivery driver: Tài xế giao hàng, Digital Marketing Manager: Giám đốc Tiếp thị kỹ thuật số, Event Coordinator: Điều phối viên sự kiện, Junior Financial Advisor: Cố vấn tài chính, Software Engineer: Kỹ sư phần mềm, Technical Recruiter: Kỹ thuật viên)

• Years of Experience: Kinh nghiệm làm việc

• Salary: Mức lương nhận được

dt <- read_excel("C:/HK2-2023/Phân tích dữ liệu định tính/btvn.xlsx")
dt

str(dt)

## tibble [6,698 × 9] (S3: tbl_df/tbl/data.frame)
##  $ ID                 : num [1:6698] 0 1 2 3 4 5 6 7 8 9 ...
##  $ Gender             : chr [1:6698] "Male" "Female" "Male" "Female" ...
##  $ Age                : num [1:6698] 32 28 45 36 52 29 42 31 26 38 ...
##  $ Country            : chr [1:6698] "UK" "USA" "Canada" "USA" ...
##  $ Race               : chr [1:6698] "White" "Hispanic" "White" "Hispanic" ...
##  $ Education Level    : chr [1:6698] "Bachelor's Degree" "Master's Degree" "PhD" "Bachelor's Degree" ...
##  $ Job Title          : chr [1:6698] "Delivery Driver" "Software Engineer" "Digital Marketing Manager" "Delivery Driver" ...
##  $ Years of Experience: num [1:6698] 5 3 15 7 20 2 12 4 1 10 ...
##  $ Salary             : num [1:6698] 90000 65000 150000 60000 200000 55000 120000 80000 45000 110000 ...