library(tidyverse)
library(dplyr)
library(knitr)
data <- read.csv(file='C:/Users/Admin/Downloads/data w4.csv', header = T)
#hiển thị cấu trúc dữ liệu
str(data)
## 'data.frame': 14962 obs. of 8 variables:
## $ Age : int 39 38 31 23 32 25 32 43 54 59 ...
## $ WorkClass : chr " State-gov" " Private" " Private" " Private" ...
## $ Education : chr " Bachelors" " HS-grad" " Masters" " Bachelors" ...
## $ MaritalStatus: chr " Never-married" " Divorced" " Never-married" " Never-married" ...
## $ Occupation : chr " Adm-clerical" " Handlers-cleaners" " Prof-specialty" " Adm-clerical" ...
## $ Gender : chr " Male" " Male" " Female" " Female" ...
## $ Country : chr " United-States" " United-States" " United-States" " United-States" ...
## $ Income : chr " <=50K" " <=50K" " >50K" " <=50K" ...
Dữ liệu được sử dụng để phân tích là bộ Adult Income, thể hiện mức thu nhập của một người lớn trong 1 năm. Bộ dữ liệu bao gồm 14962 quan sát tương ứng với 14962 người tham gia khảo sát và 8 biến bao gồm:
Age:Tuổi
Work class:Lớp công việc
Education: Học vấn
Marital Status: Tình trạng hôn nhân
Occupation: Nghề nghiệp
Gender: Giới tính
Income: Thu nhập
Ngoại trừ biến ‘Age’ thì tất cả các biến còn lại đều là biến định tính.
Kiểm tra NA cho dữ liệu
#gom các biến định tính
dinhtinh <- c('WorkClass','Education', 'MaritalStatus', 'Occupation', 'Gender', 'Income')
data_dinhtinh <- data[,dinhtinh]
#kiểm tra dữ liệu NA của các biến định tính
sum(is.na(data_dinhtinh))
## [1] 0
colSums(is.na(data_dinhtinh))
## WorkClass Education MaritalStatus Occupation Gender
## 0 0 0 0 0
## Income
## 0
Kết quả trả về cho ta thấy rằng, với 7 biến định tính, không có dữ liệu trống (NA).
Sau đó, chúng ta sẽ kiểm tra xem các biến định tính có phải là factor hay không. Nếu chúng không phải là factor thì ta sẽ chuyển đổi chúng sang dạng factor.
Kiểm tra các biến định tính có phải là factor hay chưa
#kiểm tra các biến định tính có phải là factor hay chưa
for (i in 1:ncol(data_dinhtinh)) {
a <- is.factor(data_dinhtinh[,i])
cat(colnames(data_dinhtinh)[i],":",a,"\n")
}
## WorkClass : FALSE
## Education : FALSE
## MaritalStatus : FALSE
## Occupation : FALSE
## Gender : FALSE
## Income : FALSE
Kết quả kiểm tra cho ta thấy rằng, 7 biến định tính đang không phải là factor. Vì vậy, ta tiến hành chuyển 7 biến này về dạng factor, như sau:
# Chuyển về dạng factor
for (i in 1:ncol(data_dinhtinh)) {
data_dinhtinh[,i] <- as.factor(data_dinhtinh[,i])
}
# Kiểm tra lại
for (i in 1:ncol(data_dinhtinh)) {
a <- is.factor(data_dinhtinh[,i])
cat(colnames(data_dinhtinh)[i],":",a,"\n")
}
## WorkClass : TRUE
## Education : TRUE
## MaritalStatus : TRUE
## Occupation : TRUE
## Gender : TRUE
## Income : TRUE
Lúc này, kết quả đã cho ra 7 biến định tính đã là factor. Việc chuyển đổi này sẽ giúp R hiểu rõ bản chất của biến phân loại và hỗ trợ tốt hơn cho quá trình trực quan hóa dữ liệu.
# Tạo bảng mô tả thống kê biến Work Class
tanso.workclass <- table(data$WorkClass)
tansuat.workclass <- prop.table(tanso.workclass) * 100
workclass <- data.frame(WorkClass = names(tanso.workclass), TanSo = as.vector(tanso.workclass), TanSuat = as.vector(tansuat.workclass))
kable(workclass, caption = "Bảng 1: Mô tả thống kê của biến Work Class")
| WorkClass | TanSo | TanSuat |
|---|---|---|
| Federal-gov | 449 | 3.000936 |
| Local-gov | 1004 | 6.710333 |
| Private | 11799 | 78.859778 |
| Self-emp-inc | 263 | 1.757786 |
| Self-emp-not-inc | 772 | 5.159738 |
| State-gov | 670 | 4.478011 |
| Without-pay | 5 | 0.033418 |
# Biểu đồ biến Work Class
counts <- data %>%
group_by(WorkClass) %>%
summarise(Count = n())
ggplot(counts, aes(x = WorkClass, y = Count)) +
geom_bar(stat = "identity", fill = 'skyblue') +
geom_text(aes(label = Count), vjust = -0.5, size = 4) +
labs(
title = "Hình 1: Biểu đồ cột thể hiện biến Work Class",
x = 'Lớp công việc',
y = 'Số lượng người tham gia khảo sát'
)
Biến Work Class thể hiện sự phân bố không đồng đều rõ rệt giữa các nhóm. Nhóm Private chiếm ưu thế tuyệt đối với 78,86% số quan sát, vượt trội so với các nhóm còn lại. Các nhóm như Self-emp-inc, Federal-gov và đặc biệt làm Without-pay có tần suất rất thấp, cho thấy sự chênh lệch lớn giữa các loại hình công việc trong mẫu khảo sát.
# Ước lượng khoảng Private (Làm cho công ty tư nhân)
data$WorkClass <- trimws(data$WorkClass)
table(data$WorkClass)
##
## Federal-gov Local-gov Private Self-emp-inc
## 449 1004 11799 263
## Self-emp-not-inc State-gov Without-pay
## 772 670 5
total= sum(table(data$WorkClass))
So.private = table(data$WorkClass)[["Private"]]
#với khoảng tin cậy 95%
prop.test(So.private, total, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: So.private out of total, null probability 0.5
## X-squared = 4983.5, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.7819480 0.7950987
## sample estimates:
## p
## 0.7885978
Với kết quả trên, ta có được khoảng tin cậy tỷ lệ người tham gia khảo sát làm cho công ty tư nhân trong tổng thể nằm trong khoảng từ 78.19% đến 79.51%.
Giả thuyết kiểm định:
\(H_0\): Tỷ lệ người tham gia khảo sát làm cho công ty tư nhân trong tổng số quan sát bằng 50%
\(H_1\): Tỷ lệ người tham gia khảo sát làm cho công ty tư nhân trong tổng số quan sát khác 50%
# Kiểm định H0: p = 0.5
prop.test(So.private, total, p = 0.5)
##
## 1-sample proportions test with continuity correction
##
## data: So.private out of total, null probability 0.5
## X-squared = 4983.5, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.7819480 0.7950987
## sample estimates:
## p
## 0.7885978
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức tỷ lệ người tham gia khảo sát làm cho công ty tư nhân trong tổng số quan sát **khác 50% ở mức ý nghĩa 5%.
#Tạo bảng mô tả thống kê biến Education
tanso.education <- table(data$Education)
tansuat.education <- prop.table(tanso.education) * 100
education <- data.frame(Education = names(tanso.education), TanSo = as.vector(tanso.education), TanSuat = as.vector(tansuat.education))
kable(education, caption = "Bảng 2: Mô tả thống kê của biến Education")
| Education | TanSo | TanSuat |
|---|---|---|
| 10th | 443 | 2.9608341 |
| 11th | 658 | 4.3978078 |
| 12th | 244 | 1.6307980 |
| 1st-4th | 58 | 0.3876487 |
| 5th-6th | 101 | 0.6750434 |
| 7th-8th | 200 | 1.3367197 |
| 9th | 211 | 1.4102393 |
| Assoc-acdm | 548 | 3.6626120 |
| Assoc-voc | 621 | 4.1505146 |
| Bachelors | 2324 | 15.5326828 |
| Doctorate | 110 | 0.7351958 |
| HS-grad | 4837 | 32.3285657 |
| Masters | 664 | 4.4379094 |
| Preschool | 24 | 0.1604064 |
| Prof-school | 151 | 1.0092234 |
| Some-college | 3768 | 25.1837990 |
# Biểu đồ biến Education
counts <- data %>%
group_by(Education) %>%
summarise(Count = n())
ggplot(counts, aes(x = Education, y = Count)) +
geom_bar(stat = "identity", fill = 'darkgreen') +
geom_text(aes(label = Count), vjust = -0.5, size = 4) +
labs(
title = "Hình 1: Biểu đồ cột thể hiện biến Education",
x = 'Học vấn',
y = 'Số lượng người tham gia khảo sát'
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biến trình độ học vấn có sự phân bố chênh lệch rõ rệt. Nhóm tốt nghiệp trung học phổ thông chiếm tỷ lệ cao nhất (32,33%), tiếp theo là học một phần đại học (25,18%) và cử nhân (15,53%). Ngược lại, các nhóm như mẫu giáo, lớp 1–4 và tiến sĩ có tần suất rất thấp. Điều này cho thấy phần lớn người tham gia khảo sát có trình độ học vấn từ trung học phổ thông trở lên.
# Ước lượng khoảng HS-grad (Tốt nghiệp trung học phổ thông)
data$Education <- trimws(data$Education)
table(data$Education)
##
## 10th 11th 12th 1st-4th 5th-6th 7th-8th
## 443 658 244 58 101 200
## 9th Assoc-acdm Assoc-voc Bachelors Doctorate HS-grad
## 211 548 621 2324 110 4837
## Masters Preschool Prof-school Some-college
## 664 24 151 3768
total= sum(table(data$Education))
So.edu = table(data$Education)[["HS-grad"]]
#với khoảng tin cậy 95%
prop.test(So.edu, total, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: So.edu out of total, null probability 0.5
## X-squared = 1868.2, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.3158040 0.3308584
## sample estimates:
## p
## 0.3232857
Với kết quả trên, ta có được khoảng tin cậy tỷ lệ người tham gia khảo sát tốt nghiệp trung học phổ thông trong tổng thể nằm trong khoảng từ 31.58% đến 33.09%.
Giả thuyết kiểm định:
\(H_0\): Tỷ lệ người tham gia khảo sát tốt nghiệp trung học phổ thông trong tổng số quan sát bằng 33%
\(H_1\): Tỷ lệ người tham gia khảo sát tốt nghiệp trung học phổ thông trong tổng số quan sát khác 33%
# Kiểm định H0: p = 0.5
prop.test(So.edu, total, p = 0.33)
##
## 1-sample proportions test with continuity correction
##
## data: So.edu out of total, null probability 0.33
## X-squared = 3.0205, df = 1, p-value = 0.08222
## alternative hypothesis: true p is not equal to 0.33
## 95 percent confidence interval:
## 0.3158040 0.3308584
## sample estimates:
## p
## 0.3232857
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value = 0.08222 > 0.05\), ta chưa đủ điều kiện để bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_0\), tức tỷ lệ người tham gia khảo sát tốt nghiệp trung học phổ thông trong tổng số quan sát bằng 33% ở mức ý nghĩa 5%.
# Tạo bảng mô tả thống kê biến Marital Status
tanso.maritalstatus <- table(data$MaritalStatus)
tansuat.maritalstatus <- prop.table(tanso.maritalstatus) * 100
maritalstatus <- data.frame(MaritalStatus = names(tanso.maritalstatus), TanSo = as.vector(tanso.maritalstatus), TanSuat = as.vector(tansuat.maritalstatus))
kable(maritalstatus, caption = "Bảng 3: Mô tả thống kê của biến Marital Status")
| MaritalStatus | TanSo | TanSuat |
|---|---|---|
| Divorced | 4111 | 27.476273 |
| Never-married | 9178 | 61.342067 |
| Separated | 886 | 5.921668 |
| Widowed | 787 | 5.259992 |
# Biểu đồ biến Marital Status
data %>% group_by(MaritalStatus) %>% summarise(n = n()) %>%
mutate(percentage = n / sum(n) * 100) %>%
ggplot(aes(x = '', y = n,fill = MaritalStatus)) +
geom_col(color = 'black') +
coord_polar('y') +
geom_text(aes(x = 1.3, label = paste0(round(percentage, 1), "%")),position = position_stack(vjust = .5)) +
theme_void() +
labs(title = 'Hình 3: Biểu đồ tròn thể hiện tình trạng hôn nhân của mỗi khách hàng', x = ' ', y = ' ')
Biến tình trạng hôn nhân cho thấy phần lớn khách hàng chưa từng kết hôn (61,3%). Nhóm đã ly hôn chiếm tỷ lệ thứ hai với 27,5%. Trong khi đó, hai nhóm ly thân và góa có tỷ lệ khá thấp, lần lượt là 5,9% và 5,3%. Kết quả này cho thấy đa số người tham gia khảo sát thuộc nhóm độc thân.
# Ước lượng khoảng Never-married (Chưa từng kết hôn)
data$MaritalStatus <- trimws(data$MaritalStatus)
table(data$MaritalStatus)
##
## Divorced Never-married Separated Widowed
## 4111 9178 886 787
total= sum(table(data$MaritalStatus))
So.married = table(data$MaritalStatus)[["Never-married"]]
#với khoảng tin cậy 95%
prop.test(So.married, total, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: So.married out of total, null probability 0.5
## X-squared = 769.45, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.6055561 0.6212267
## sample estimates:
## p
## 0.6134207
Với kết quả trên, ta có được khoảng tin cậy tỷ lệ người tham gia khảo sát chưa kết hôn trong tổng thể nằm trong khoảng từ 60.56% đến 62.12%.
Giả thuyết kiểm định:
\(H_0\): Tỷ lệ người tham gia khảo sát chưa kết hôn trong tổng số quan sát bằng 62%
\(H_1\): Tỷ lệ người tham gia khảo sát chưa kết hôn trong tổng số quan sát khác 62%
# Kiểm định H0: p = 0.5
prop.test(So.married, total, p = 0.62)
##
## 1-sample proportions test with continuity correction
##
## data: So.married out of total, null probability 0.62
## X-squared = 2.7212, df = 1, p-value = 0.09903
## alternative hypothesis: true p is not equal to 0.62
## 95 percent confidence interval:
## 0.6055561 0.6212267
## sample estimates:
## p
## 0.6134207
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value = 0.09903 > 0.05\), ta chưa đủ điều kiện để bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_0\), tức tỷ lệ người tham gia khảo sát chưa kết hôn trong tổng số quan sát bằng 62% ở mức ý nghĩa 5%.
#Tạo bảng mô tả thống kê biến Occupation
tanso.occupation <- table(data$Occupation)
tansuat.occupation <- prop.table(tanso.occupation) * 100
occupation <- data.frame(Occupation = names(tanso.occupation), TanSo = as.vector(tanso.occupation), TanSuat = as.vector(tansuat.occupation))
kable(occupation, caption = "Bảng 4: Mô tả thống kê của biến Occupation")
| Occupation | TanSo | TanSuat |
|---|---|---|
| Adm-clerical | 2575 | 17.210266 |
| Armed-Forces | 5 | 0.033418 |
| Craft-repair | 1379 | 9.216682 |
| Exec-managerial | 1529 | 10.219222 |
| Farming-fishing | 365 | 2.439513 |
| Handlers-cleaners | 790 | 5.280043 |
| Machine-op-inspct | 908 | 6.068707 |
| Other-service | 2293 | 15.325491 |
| Priv-house-serv | 112 | 0.748563 |
| Prof-specialty | 1881 | 12.571849 |
| Protective-serv | 250 | 1.670900 |
| Sales | 1833 | 12.251036 |
| Tech-support | 489 | 3.268280 |
| Transport-moving | 553 | 3.696030 |
# Biểu đồ biến Occupation
counts <- data %>%
group_by(Occupation) %>%
summarise(Count = n())
ggplot(counts, aes(x = Occupation, y = Count)) +
geom_bar(stat = "identity", fill = 'brown') +
geom_text(aes(label = Count), vjust = -0.5, size = 4) +
labs(
title = "Hình 4: Biểu đồ cột thể hiện biến Occupation",
x = 'Nghề nghiệp',
y = 'Số lượng người tham gia khảo sát'
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biến nghề nghiệp cho thấy nhóm làm công việc hành chính - văn phòng chiếm tỷ lệ cao nhất trong mẫu khảo sát với 17,2%. Theo sau là các nhóm dịch vụ khác (15,3%), quản lý - điều hành (10,2%), chuyên gia (12,6%) và bán hàng (12,3%). Ngược lại, nhóm làm trong lực lượng vũ trang (0,03%) và giúp việc nhà tư nhân (0,75%) có tỷ lệ rất thấp. Phân bố này phản ánh sự đa dạng về nghề nghiệp trong tập dữ liệu, đồng thời cho thấy lực lượng lao động tham gia khảo sát chủ yếu hoạt động trong lĩnh vực văn phòng, dịch vụ và chuyên môn.
# Tạo bảng mô tả thống kê biến Gender
tanso.gender <- table(data$Gender)
tansuat.gender <- prop.table(tanso.maritalstatus) * 100
gender <- data.frame(Gender = names(tanso.gender), TanSo = as.vector(tanso.gender), TanSuat = as.vector(tansuat.gender))
kable(gender, caption = "Bảng 5: Mô tả thống kê của biến Gender")
| Gender | TanSo | TanSuat |
|---|---|---|
| Female | 7771 | 27.476273 |
| Male | 7191 | 61.342067 |
| Female | 7771 | 5.921668 |
| Male | 7191 | 5.259992 |
# Biểu đồ biến Gender
data %>% group_by(Gender) %>% summarise(n = n()) %>%
mutate(percentage = n / sum(n) * 100) %>%
ggplot(aes(x = '', y = n,fill = Gender)) +
geom_col(color = 'black') +
coord_polar('y') +
geom_text(aes(x = 1.3, label = paste0(round(percentage, 1), "%")),position = position_stack(vjust = .5)) +
theme_void() +
labs(title = 'Hình 5: Biểu đồ tròn thể hiện giới tính của mỗi khách hàng', x = ' ', y = ' ')
Biểu đồ tròn và bảng mô tả thống kê cho thấy tỉ lệ khách hàng nữ chiếm 51,9%, cao hơn nhẹ so với khách hàng nam với 48,1%. Sự phân bố gần như cân bằng này cho thấy dữ liệu không bị thiên lệch đáng kể về giới tính, giúp đảm bảo tính đại diện cho cả hai nhóm giới trong quá trình phân tích và đánh giá các yếu tố liên quan đến hành vi hoặc đặc điểm của khách hàng.
#Tạo bảng mô tả thống kê biến Country
tanso.country <- table(data$Country)
tansuat.country <- prop.table(tanso.country) * 100
country <- data.frame(Country = names(tanso.country), TanSo = as.vector(tanso.country), TanSuat = as.vector(tansuat.country))
kable(country, caption = "Bảng 6: Mô tả thống kê của biến Country")
| Country | TanSo | TanSuat |
|---|---|---|
| Cambodia | 4 | 0.0267344 |
| Canada | 49 | 0.3274963 |
| China | 15 | 0.1002540 |
| Columbia | 32 | 0.2138752 |
| Cuba | 39 | 0.2606603 |
| Dominican-Republic | 34 | 0.2272423 |
| Ecuador | 7 | 0.0467852 |
| El-Salvador | 47 | 0.3141291 |
| England | 47 | 0.3141291 |
| France | 14 | 0.0935704 |
| Germany | 63 | 0.4210667 |
| Greece | 8 | 0.0534688 |
| Guatemala | 28 | 0.1871408 |
| Haiti | 17 | 0.1136212 |
| Honduras | 8 | 0.0534688 |
| Hong | 4 | 0.0267344 |
| Hungary | 6 | 0.0401016 |
| India | 26 | 0.1737736 |
| Iran | 16 | 0.1069376 |
| Ireland | 15 | 0.1002540 |
| Italy | 18 | 0.1203048 |
| Jamaica | 41 | 0.2740275 |
| Japan | 26 | 0.1737736 |
| Laos | 6 | 0.0401016 |
| Mexico | 214 | 1.4302901 |
| Nicaragua | 14 | 0.0935704 |
| Outlying-US(Guam-USVI-etc) | 11 | 0.0735196 |
| Peru | 17 | 0.1136212 |
| Philippines | 67 | 0.4478011 |
| Poland | 19 | 0.1269884 |
| Portugal | 15 | 0.1002540 |
| Puerto-Rico | 54 | 0.3609143 |
| Scotland | 6 | 0.0401016 |
| South | 26 | 0.1737736 |
| Taiwan | 14 | 0.0935704 |
| Thailand | 8 | 0.0534688 |
| Trinadad&Tobago | 8 | 0.0534688 |
| United-States | 13888 | 92.8218153 |
| Vietnam | 27 | 0.1804572 |
| Yugoslavia | 4 | 0.0267344 |
Biểu đồ cột cho thấy đa số người tham gia khảo sát đến từ Hoa Kỳ (United States), chiếm áp đảo với 13.888 người, tương đương 92,82% tổng mẫu. Trong khi đó, các quốc gia còn lại chỉ chiếm tỷ lệ rất nhỏ, mỗi nước dao động từ vài cá nhân đến vài chục người, chiếm dưới 1% mỗi quốc gia. Những quốc gia có số lượng tương đối nổi bật sau Hoa Kỳ gồm Mexico (1,43%), Philippines (0,45%), Germany (0,42%) và Puerto-Rico (0,36%).
Sự mất cân đối nghiêm trọng trong phân bố quốc tịch này cho thấy dữ liệu có thể phản ánh chủ yếu bối cảnh và đặc điểm của cư dân Hoa Kỳ.
# Tạo bảng mô tả thống kê biến Income
tanso.income <- table(data$Income)
tansuat.income <- prop.table(tanso.income) * 100
income <- data.frame(Income = names(tanso.income), TanSo = as.vector(tanso.income), TanSuat = as.vector(tansuat.income))
kable(income, caption = "Bảng 7: Mô tả thống kê của biến Income")
| Income | TanSo | TanSuat |
|---|---|---|
| <=50K | 13910 | 92.968854 |
| >50K | 1052 | 7.031146 |
# Biểu đồ biến Income
data %>% group_by(Income) %>% summarise(n = n()) %>%
mutate(percentage = n / sum(n) * 100) %>%
ggplot(aes(x = '', y = n,fill = Income)) +
geom_col(color = 'black') +
coord_polar('y') +
geom_text(aes(x = 1.3, label = paste0(round(percentage, 1), "%")),position = position_stack(vjust = .5)) +
theme_void() +
labs(title = 'Hình 7: Biểu đồ tròn thể hiện thu nhập của mỗi khách hàng', x = ' ', y = ' ')
Biểu đồ tròn cho thấy phần lớn khách hàng trong tập dữ liệu có thu nhập dưới hoặc bằng 50.000 USD, chiếm 93% tổng số người tham gia khảo sát, tương đương 13.910 người. Trong khi đó, chỉ có 7% khách hàng có thu nhập trên 50.000 USD, tương ứng 1.052 người.
Biến phụ thuộc là: Income và Education
# Bần suất giữa Marital Status và Income
tanso1 <- table(data$MaritalStatus, data$Income)
tansuat1 <- prop.table(tanso1, margin = 1) * 100
bang1 <- as.data.frame(tanso1)
bang1$Percentage <- round(as.vector(tansuat1), 2)
colnames(bang1) <- c("Marital Status", "Income", "Tần số", "Tần suất")
kable(bang1, caption = "Bảng 8: Mô tả thống kê của 2 biến Marital Status và Income")
| Marital Status | Income | Tần số | Tần suất |
|---|---|---|---|
| Divorced | <=50K | 3664 | 89.13 |
| Never-married | <=50K | 8716 | 94.97 |
| Separated | <=50K | 822 | 92.78 |
| Widowed | <=50K | 708 | 89.96 |
| Divorced | >50K | 447 | 10.87 |
| Never-married | >50K | 462 | 5.03 |
| Separated | >50K | 64 | 7.22 |
| Widowed | >50K | 79 | 10.04 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Income, fill = MaritalStatus)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 8: Mối quan hệ giữa Marital Status và Income",
x = "Thu nhập",
y = "Số lượng",
fill = "Tình trạng hôn nhân"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biểu đồ cho thấy phần lớn những người có thu nhập dưới 50K thuộc nhóm chưa từng kết hôn, tiếp theo là nhóm đã ly hôn, trong khi hai nhóm sống ly thân và góa vợ/chồng chiếm tỷ lệ thấp hơn đáng kể. Ở chiều ngược lại, số người có thu nhập trên 50K ở tất cả các nhóm tình trạng hôn nhân đều rất thấp. Điều này cho thấy thu nhập cao là tương đối hiếm trong tập dữ liệu và không phụ thuộc nhiều vào tình trạng hôn nhân.
Giả thuyết kiểm định:
\(H_0\): Biến MaritalStatus (tình trạng hôn nhân) không ảnh hưởng đến biến Income (thu nhập)
\(H_1\): Biến MaritalStatus (tình trạng hôn nhân) có ảnh hưởng đến biến Income (thu nhập)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso1)
chi_test
##
## Pearson's Chi-squared test
##
## data: tanso1
## X-squared = 159.79, df = 3, p-value < 2.2e-16
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến MaritalStatus (tình trạng hôn nhân) có ảnh hưởng đến biến Income (thu nhập) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Income là <=50 và >50. Với biến MaritalStatus, hạng mục quan tâm Never-married và Separated.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$MaritalStatus <- trimws(data$MaritalStatus)
data$Income <- trimws(data$Income)
# Lọc ra những hàng có MaritalStatus và Income như yêu cầu
tsc1 <- subset(data,
MaritalStatus %in% c("Never-married", "Separated") &
Income %in% c("<=50K", ">50K"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc1 <- droplevels(tsc1)
table1 <- table(tsc1$MaritalStatus, tsc1$Income)
kable (table1)
| <=50K | >50K | |
|---|---|---|
| Never-married | 8716 | 462 |
| Separated | 822 | 64 |
#Tính RR
riskratio(table1)
## $data
##
## <=50K >50K Total
## Never-married 8716 462 9178
## Separated 822 64 886
## Total 9538 526 10064
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Never-married 1.000000 NA NA
## Separated 1.435001 1.115172 1.846558
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Never-married NA NA NA
## Separated 0.007436189 0.007063501 0.005163426
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table1)
## $data
##
## <=50K >50K Total
## Never-married 8716 462 9178
## Separated 822 64 886
## Total 9538 526 10064
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Never-married 1.000000 NA NA
## Separated 1.471844 1.112743 1.915858
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Never-married NA NA NA
## Separated 0.007436189 0.007063501 0.005163426
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả cho thấy: trong nhóm người tham gia khảo sát, những ai đã ly thân (Separated) có khả năng kiếm được trên 50K cao hơn so với người chưa từng kết hôn (Never-married).
Cụ thể, tỷ lệ này cao hơn khoảng 1.47 lần (gọi là odds ratio). Khoảng tin cậy từ 1.11 đến 1.92 nghĩa là kết quả này khá chắc chắn. Ba cách kiểm tra khác nhau đều cho ra giá trị p nhỏ hơn 0.01, tức là sự khác biệt này không phải do ngẫu nhiên, mà có ý nghĩa thống kê.
# Bần suất giữa Gender và Income
tanso2 <- table(data$Gender, data$Income)
tansuat2 <- prop.table(tanso2, margin = 1) * 100
bang2 <- as.data.frame(tanso2)
bang2$Percentage <- round(as.vector(tansuat2), 2)
colnames(bang2) <- c("Gender", "Income", "Tần số", "Tần suất")
kable(bang2, caption = "Bảng 9: Mô tả thống kê của 2 biến Gender và Income")
| Gender | Income | Tần số | Tần suất |
|---|---|---|---|
| Female | <=50K | 7380 | 94.97 |
| Male | <=50K | 6530 | 90.81 |
| Female | >50K | 391 | 5.03 |
| Male | >50K | 661 | 9.19 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Income, fill = Gender)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 9: Mối quan hệ giữa Gender và Income",
x = "Thu nhập",
y = "Số lượng",
fill = "Giới tính"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Bảng thống kê và biểu đồ minh họa mối quan hệ giữa giới tính và thu nhập cho thấy sự khác biệt rõ rệt trong phân bố thu nhập giữa hai nhóm giới tính. Cụ thể, với mức thu nhập ≤50K, cả nữ giới (7.380 người, chiếm 94,97%) và nam giới (6.530 người, chiếm 90,81%) đều chiếm tỷ lệ rất cao, cho thấy phần lớn dân số có thu nhập thấp. Tuy nhiên, ở mức thu nhập >50K, tỷ lệ này giảm mạnh, với nữ giới chỉ còn 391 người (5,03%) và nam giới là 661 người (9,19%), phản ánh sự bất cân đối giới trong nhóm thu nhập cao. Biểu đồ cột trực quan hóa dữ liệu này, nhấn mạnh sự chênh lệch đáng kể về số lượng ở cả hai ngưỡng thu nhập, đặc biệt ở nhóm thu nhập cao, nơi nam giới vượt trội hơn nữ giới. Kết quả này có thể là cơ sở để nghiên cứu sâu hơn về các yếu tố xã hội và kinh tế ảnh hưởng đến phân hóa thu nhập theo giới tính.
Giả thuyết kiểm định:
\(H_0\): Biến Gender (Giới tính) không ảnh hưởng đến biến Income (thu nhập)
\(H_1\): Biến Gender (Giới tính) có ảnh hưởng đến biến Income (thu nhập)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso2)
chi_test
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tanso2
## X-squared = 98.267, df = 1, p-value < 2.2e-16
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến Gender (tình trạng hôn nhân) có ảnh hưởng đến biến Income (thu nhập) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Income là <=50 và >50. Với biến Gender, hạng mục quan tâm Female và Male.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$Gender <- trimws(data$Gender)
data$Income <- trimws(data$Income)
# Lọc ra những hàng có Gender và Income như yêu cầu
tsc2 <- subset(data,
Gender %in% c("Female", "Male") &
Income %in% c("<=50K", ">50K"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc2 <- droplevels(tsc2)
table2 <- table(tsc2$Gender, tsc2$Income)
kable (table2)
| <=50K | >50K | |
|---|---|---|
| Female | 7380 | 391 |
| Male | 6530 | 661 |
#Tính RR
riskratio(table2)
## $data
##
## <=50K >50K Total
## Female 7380 391 7771
## Male 6530 661 7191
## Total 13910 1052 14962
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Female 1.00000 NA NA
## Male 1.82689 1.618909 2.06159
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0 2.390587e-23 2.652276e-23
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table2)
## $data
##
## <=50K >50K Total
## Female 7380 391 7771
## Male 6530 661 7191
## Total 13910 1052 14962
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Female 1.000000 NA NA
## Male 1.910203 1.679273 2.175744
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0 2.390587e-23 2.652276e-23
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả phân tích cho thấy: nam giới (Male) có khả năng kiếm được trên 50K cao hơn gần 2 lần so với nữ giới (Female) trong bộ dữ liệu khảo sát.
Cụ thể, tỷ số odds (odds ratio) là 1.91, nghĩa là nam có khả năng có thu nhập trên 50K cao hơn khoảng 1.91 lần so với nữ. Khoảng tin cậy 95% từ 1.68 đến 2.18 cho thấy kết quả này rất chắc chắn, vì nó không bao gồm giá trị 1. Thêm vào đó, các kiểm định thống kê (mid-p exact, Fisher’s exact, và chi-square) đều cho ra giá trị p gần bằng 0, tức là sự khác biệt này có ý nghĩa thống kê cao và không phải do ngẫu nhiên.
# Bần suất giữa Gender và Income
tanso3 <- table(data$Occupation, data$Income)
tansuat3 <- prop.table(tanso3, margin = 1) * 100
bang3 <- as.data.frame(tanso3)
bang3$Percentage <- round(as.vector(tansuat3), 2)
colnames(bang3) <- c("Occupation", "Income", "Tần số", "Tần suất")
kable(bang3, caption = "Bảng 10: Mô tả thống kê của 2 biến Occupation và Income")
| Occupation | Income | Tần số | Tần suất |
|---|---|---|---|
| Adm-clerical | <=50K | 2507 | 97.36 |
| Armed-Forces | <=50K | 5 | 100.00 |
| Craft-repair | <=50K | 1295 | 93.91 |
| Exec-managerial | <=50K | 1241 | 81.16 |
| Farming-fishing | <=50K | 354 | 96.99 |
| Handlers-cleaners | <=50K | 785 | 99.37 |
| Machine-op-inspct | <=50K | 898 | 98.90 |
| Other-service | <=50K | 2266 | 98.82 |
| Priv-house-serv | <=50K | 111 | 99.11 |
| Prof-specialty | <=50K | 1553 | 82.56 |
| Protective-serv | <=50K | 220 | 88.00 |
| Sales | <=50K | 1698 | 92.64 |
| Tech-support | <=50K | 452 | 92.43 |
| Transport-moving | <=50K | 525 | 94.94 |
| Adm-clerical | >50K | 68 | 2.64 |
| Armed-Forces | >50K | 0 | 0.00 |
| Craft-repair | >50K | 84 | 6.09 |
| Exec-managerial | >50K | 288 | 18.84 |
| Farming-fishing | >50K | 11 | 3.01 |
| Handlers-cleaners | >50K | 5 | 0.63 |
| Machine-op-inspct | >50K | 10 | 1.10 |
| Other-service | >50K | 27 | 1.18 |
| Priv-house-serv | >50K | 1 | 0.89 |
| Prof-specialty | >50K | 328 | 17.44 |
| Protective-serv | >50K | 30 | 12.00 |
| Sales | >50K | 135 | 7.36 |
| Tech-support | >50K | 37 | 7.57 |
| Transport-moving | >50K | 28 | 5.06 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Income, fill = Occupation)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 10: Mối quan hệ giữa Occupation và Income",
x = "Thu nhập",
y = "Số lượng",
fill = "Nghề nghiệp"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Bảng thống kê và biểu đồ minh họa mối quan hệ giữa nghề nghiệp, giới tính và thu nhập cho thấy sự phân bố không đồng đều giữa các nhóm nghề nghiệp theo ngưỡng thu nhập ≤50K và >50K. Ở mức thu nhập ≤50K, các nghề như Hành chính-văn phòng (2.507 người, 97,36%), Dịch vụ khác (2.266 người, 98,82%) và Chuyên môn cao (1.553 người, 82,56%) chiếm tỷ lệ cao, trong khi các nghề như Lực lượng vũ trang (5 người, 100%) và Dịch vụ gia đình (111 người, 99,11%) có số lượng rất thấp. Với thu nhập >50K, nghề Quản lý điều hành (288 người, 18,84%) và Chuyên môn cao (328 người, 17,44%) nổi bật với tỷ lệ cao hơn hẳn, trong khi các nghề như Lao động tay chân (5 người, 0,63%) và Lực lượng vũ trang (0 người, 0%) gần như không có đại diện. Biểu đồ cột trực quan hóa dữ liệu này, nhấn mạnh sự tập trung lớn ở ngưỡng thu nhập thấp và sự khác biệt rõ rệt giữa các nghề ở ngưỡng thu nhập cao, gợi mở các nghiên cứu tiếp theo về ảnh hưởng của nghề nghiệp đến phân hóa thu nhập.
Giả thuyết kiểm định:
\(H_0\): Biến Occupation (nghề nghiệp) không ảnh hưởng đến biến Income (thu nhập)
\(H_1\): Biến Occupation (nghề nghiệp) có ảnh hưởng đến biến Income (thu nhập)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso3)
## Warning in chisq.test(tanso3): Chi-squared approximation may be incorrect
chi_test
##
## Pearson's Chi-squared test
##
## data: tanso3
## X-squared = 962.97, df = 13, p-value < 2.2e-16
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến Occupation (nghề nghiệp) có ảnh hưởng đến biến Income (thu nhập) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Income là <=50 và >50. Với biến Occupation, hạng mục quan tâm Sales và Transport-moving.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$Occupation <- trimws(data$Occupation)
data$Income <- trimws(data$Income)
# Lọc ra những hàng có Occupation và Income như yêu cầu
tsc3 <- subset(data,
Occupation %in% c("Sales", "Transport-moving") &
Income %in% c("<=50K", ">50K"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc3 <- droplevels(tsc3)
table3 <- table(tsc3$Occupation, tsc3$Income)
kable (table3)
| <=50K | >50K | |
|---|---|---|
| Sales | 1698 | 135 |
| Transport-moving | 525 | 28 |
#Tính RR
riskratio(table3)
## $data
##
## <=50K >50K Total
## Sales 1698 135 1833
## Transport-moving 525 28 553
## Total 2223 163 2386
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Sales 1.0000000 NA NA
## Transport-moving 0.6874824 0.4628019 1.021241
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Sales NA NA NA
## Transport-moving 0.05551996 0.06729622 0.0600471
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table3)
## $data
##
## <=50K >50K Total
## Sales 1698 135 1833
## Transport-moving 525 28 553
## Total 2223 163 2386
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Sales 1.0000000 NA NA
## Transport-moving 0.6738799 0.4347032 1.00902
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Sales NA NA NA
## Transport-moving 0.05551996 0.06729622 0.0600471
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả phân tích so sánh giữa hai nhóm nghề nghiệp “Sales” và “Transport-moving” cho thấy:
Tỷ số odds (odds ratio) = 0.67, nghĩa là người làm nghề Transport-moving có khả năng có thu nhập >50K thấp hơn khoảng 33% so với người làm nghề Sales.
Khoảng tin cậy 95% (0.43 đến 1.01) cho thấy mức độ không chắc chắn: vì khoảng này có chứa giá trị 1, ta không thể kết luận chắc chắn rằng sự khác biệt là có thật.
Các giá trị p-value (mid-p = 0.056, Fisher = 0.067, Chi-square = 0.060) đều hơi lớn hơn 0.05, tức là không đủ mạnh để bác bỏ giả thuyết rằng hai nghề có cùng xác suất đạt thu nhập >50K.
# Bần suất giữa Marital Status và Education
tanso4 <- table(data$MaritalStatus, data$Education)
tansuat4 <- prop.table(tanso1, margin = 1) * 100
bang4 <- as.data.frame(tanso4)
bang4$Percentage <- round(as.vector(tansuat4), 2)
colnames(bang4) <- c("Marital Status", "Education", "Tần số", "Tần suất")
kable(bang4, caption = "Bảng 11: Mô tả thống kê của 2 biến Marital Status và Education")
| Marital Status | Education | Tần số | Tần suất |
|---|---|---|---|
| Divorced | 10th | 102 | 89.13 |
| Never-married | 10th | 270 | 94.97 |
| Separated | 10th | 39 | 92.78 |
| Widowed | 10th | 32 | 89.96 |
| Divorced | 11th | 113 | 10.87 |
| Never-married | 11th | 474 | 5.03 |
| Separated | 11th | 40 | 7.22 |
| Widowed | 11th | 31 | 10.04 |
| Divorced | 12th | 34 | 89.13 |
| Never-married | 12th | 192 | 94.97 |
| Separated | 12th | 9 | 92.78 |
| Widowed | 12th | 9 | 89.96 |
| Divorced | 1st-4th | 8 | 10.87 |
| Never-married | 1st-4th | 31 | 5.03 |
| Separated | 1st-4th | 6 | 7.22 |
| Widowed | 1st-4th | 13 | 10.04 |
| Divorced | 5th-6th | 17 | 89.13 |
| Never-married | 5th-6th | 62 | 94.97 |
| Separated | 5th-6th | 15 | 92.78 |
| Widowed | 5th-6th | 7 | 89.96 |
| Divorced | 7th-8th | 58 | 10.87 |
| Never-married | 7th-8th | 82 | 5.03 |
| Separated | 7th-8th | 17 | 7.22 |
| Widowed | 7th-8th | 43 | 10.04 |
| Divorced | 9th | 51 | 89.13 |
| Never-married | 9th | 118 | 94.97 |
| Separated | 9th | 25 | 92.78 |
| Widowed | 9th | 17 | 89.96 |
| Divorced | Assoc-acdm | 197 | 10.87 |
| Never-married | Assoc-acdm | 302 | 5.03 |
| Separated | Assoc-acdm | 30 | 7.22 |
| Widowed | Assoc-acdm | 19 | 10.04 |
| Divorced | Assoc-voc | 223 | 89.13 |
| Never-married | Assoc-voc | 331 | 94.97 |
| Separated | Assoc-voc | 38 | 92.78 |
| Widowed | Assoc-voc | 29 | 89.96 |
| Divorced | Bachelors | 507 | 10.87 |
| Never-married | Bachelors | 1664 | 5.03 |
| Separated | Bachelors | 83 | 7.22 |
| Widowed | Bachelors | 70 | 10.04 |
| Divorced | Doctorate | 31 | 89.13 |
| Never-married | Doctorate | 66 | 94.97 |
| Separated | Doctorate | 7 | 92.78 |
| Widowed | Doctorate | 6 | 89.96 |
| Divorced | HS-grad | 1489 | 10.87 |
| Never-married | HS-grad | 2680 | 5.03 |
| Separated | HS-grad | 345 | 7.22 |
| Widowed | HS-grad | 323 | 10.04 |
| Divorced | Masters | 228 | 89.13 |
| Never-married | Masters | 377 | 94.97 |
| Separated | Masters | 23 | 92.78 |
| Widowed | Masters | 36 | 89.96 |
| Divorced | Preschool | 1 | 10.87 |
| Never-married | Preschool | 21 | 5.03 |
| Separated | Preschool | 1 | 7.22 |
| Widowed | Preschool | 1 | 10.04 |
| Divorced | Prof-school | 52 | 89.13 |
| Never-married | Prof-school | 86 | 94.97 |
| Separated | Prof-school | 8 | 92.78 |
| Widowed | Prof-school | 5 | 89.96 |
| Divorced | Some-college | 1000 | 10.87 |
| Never-married | Some-college | 2422 | 5.03 |
| Separated | Some-college | 200 | 7.22 |
| Widowed | Some-college | 146 | 10.04 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Education, fill = MaritalStatus)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 11: Mối quan hệ giữa Marital Status và Education",
x = "Học vấn",
y = "Số lượng",
fill = "Tình trạng hôn nhân"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biểu đồ và bảng thống kê cho thấy tình trạng hôn nhân phân bố không đồng đều theo trình độ học vấn. Nhóm chưa từng kết hôn chiếm tỷ lệ cao ở bậc HS-grad (2.680 người) và Some-college (2.422 người), trong khi nhóm ly hôn cũng đáng kể với 1.489 và 1.000 người ở hai bậc này. Nhóm goá và ly thân ít hơn nhưng vẫn trải rộng ở các bậc học. Ở các bậc học thấp như Preschool hay 1st-4th, số lượng người thuộc mọi tình trạng hôn nhân đều rất thấp.
Giả thuyết kiểm định:
\(H_0\): Biến MaritalStatus (tình trạng hôn nhân) không ảnh hưởng đến biến Education (học vấn)
\(H_1\): Biến MaritalStatus (tình trạng hôn nhân) có ảnh hưởng đến biến Education (học vấn)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso4)
## Warning in chisq.test(tanso4): Chi-squared approximation may be incorrect
chi_test
##
## Pearson's Chi-squared test
##
## data: tanso4
## X-squared = 561.08, df = 45, p-value < 2.2e-16
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến MaritalStatus (tình trạng hôn nhân) có ảnh hưởng đến biến Education (học vấn) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Income là Bachelors và Masters. Với biến MaritalStatus, hạng mục quan tâm Never-married và Separated.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$MaritalStatus <- trimws(data$MaritalStatus)
data$Education <- trimws(data$Education)
# Lọc ra những hàng có MaritalStatus và Education như yêu cầu
tsc4 <- subset(data,
MaritalStatus %in% c("Never-married", "Separated") &
Education %in% c("Bachelors", "Masters"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc4 <- droplevels(tsc4)
table4 <- table(tsc4$MaritalStatus, tsc4$Education)
kable (table4)
| Bachelors | Masters | |
|---|---|---|
| Never-married | 1664 | 377 |
| Separated | 83 | 23 |
#Tính RR
riskratio(table4)
## $data
##
## Bachelors Masters Total
## Never-married 1664 377 2041
## Separated 83 23 106
## Total 1747 400 2147
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Never-married 1.000000 NA NA
## Separated 1.174691 0.8090142 1.705655
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Never-married NA NA NA
## Separated 0.4048749 0.4420317 0.4054528
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table4)
## $data
##
## Bachelors Masters Total
## Never-married 1664 377 2041
## Separated 83 23 106
## Total 1747 400 2147
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Never-married 1.000000 NA NA
## Separated 1.228948 0.7468472 1.945653
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Never-married NA NA NA
## Separated 0.4048749 0.4420317 0.4054528
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả phân tích so sánh giữa hai nhóm tình trạng hôn nhân Never-married và Separate và cho thấy:
Tỷ số odds (odds ratio) = 1.23, nghĩa là người có tình trạng hôn nhân Separated có khả năng có học vấn Masters cao hơn khoảng 33% so với người có tình trạng hôn nhân là Never-married.
Khoảng tin cậy 95% (0.75 đến 1.95) cho thấy mức độ không chắc chắn: vì khoảng này có chứa giá trị 1, ta không thể kết luận chắc chắn rằng sự khác biệt là có thật.
Các giá trị p-value (mid-p = 0.404, Fisher = 0.44, Chi-square = 0.405) đều hơi lớn hơn 0.05, tức là không đủ mạnh để bác bỏ giả thuyết rằng hai tình trạng hồn nhân có cùng xác suất có học vấn Masters.
# Bần suất giữa Gender và Education
tanso5 <- table(data$Gender, data$Education)
tansuat5 <- prop.table(tanso5, margin = 1) * 100
bang5 <- as.data.frame(tanso5)
bang5$Percentage <- round(as.vector(tansuat5), 2)
colnames(bang5) <- c("Gender", "Education", "Tần số", "Tần suất")
kable(bang5, caption = "Bảng 12: Mô tả thống kê của 2 biến Gender và Education")
| Gender | Education | Tần số | Tần suất |
|---|---|---|---|
| Female | 10th | 204 | 2.63 |
| Male | 10th | 239 | 3.32 |
| Female | 11th | 319 | 4.11 |
| Male | 11th | 339 | 4.71 |
| Female | 12th | 101 | 1.30 |
| Male | 12th | 143 | 1.99 |
| Female | 1st-4th | 28 | 0.36 |
| Male | 1st-4th | 30 | 0.42 |
| Female | 5th-6th | 43 | 0.55 |
| Male | 5th-6th | 58 | 0.81 |
| Female | 7th-8th | 95 | 1.22 |
| Male | 7th-8th | 105 | 1.46 |
| Female | 9th | 91 | 1.17 |
| Male | 9th | 120 | 1.67 |
| Female | Assoc-acdm | 313 | 4.03 |
| Male | Assoc-acdm | 235 | 3.27 |
| Female | Assoc-voc | 363 | 4.67 |
| Male | Assoc-voc | 258 | 3.59 |
| Female | Bachelors | 1184 | 15.24 |
| Male | Bachelors | 1140 | 15.85 |
| Female | Doctorate | 60 | 0.77 |
| Male | Doctorate | 50 | 0.70 |
| Female | HS-grad | 2428 | 31.24 |
| Male | HS-grad | 2409 | 33.50 |
| Female | Masters | 389 | 5.01 |
| Male | Masters | 275 | 3.82 |
| Female | Preschool | 10 | 0.13 |
| Male | Preschool | 14 | 0.19 |
| Female | Prof-school | 60 | 0.77 |
| Male | Prof-school | 91 | 1.27 |
| Female | Some-college | 2083 | 26.80 |
| Male | Some-college | 1685 | 23.43 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Education, fill = Gender)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 12: Mối quan hệ giữa Gender và Education",
x = "Học vấn",
y = "Số lượng",
fill = "Giới tính"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biểu đồ và bảng thống kê cho thấy nam và nữ phân bố khá tương đồng ở hầu hết các bậc học, nhưng vẫn có sự chênh lệch nhẹ ở một số nhóm. Ở bậc HS-grad và Some-college, cả nam và nữ đều chiếm số lượng cao, trong đó nữ nhỉnh hơn ở Some-college (2.083 so với 1.685 nam), còn nam nhỉnh hơn ở HS-grad (2.409 so với 2.428 nữ). Nữ có tỷ lệ cao hơn ở bậc Assoc-acdm, Assoc-voc và Masters, trong khi nam chiếm ưu thế ở Prof-school và Preschool. Nhìn chung, nữ giới có xu hướng tập trung nhiều ở bậc học trung cấp và cao đẳng, còn nam có phần nổi bật hơn ở các bậc học nghề chuyên sâu.
Giả thuyết kiểm định:
\(H_0\): Biến Gender (Giới tính) không ảnh hưởng đến biến Education (học vấn) \(H_1\): Biến Gender (Giới tính) có ảnh hưởng đến biến Education (học vấn)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso5)
chi_test
##
## Pearson's Chi-squared test
##
## data: tanso5
## X-squared = 94.358, df = 15, p-value = 1.515e-13
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value = 1.515e-13 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến Gender (tình trạng hôn nhân) có ảnh hưởng đến biến Education (học vấn) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Education là Bachelors và Masters. Với biến Gender, hạng mục quan tâm Female và Male.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$Gender <- trimws(data$Gender)
data$Education <- trimws(data$Education)
# Lọc ra những hàng có Gender và Education như yêu cầu
tsc5 <- subset(data,
Gender %in% c("Female", "Male") &
Education %in% c("Bachelors", "Masters"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc5 <- droplevels(tsc5)
table5 <- table(tsc5$Gender, tsc5$Education)
kable (table5)
| Bachelors | Masters | |
|---|---|---|
| Female | 1184 | 389 |
| Male | 1140 | 275 |
#Tính RR
riskratio(table5)
## $data
##
## Bachelors Masters Total
## Female 1184 389 1573
## Male 1140 275 1415
## Total 2324 664 2988
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.7858784 0.6854674 0.9009983
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.0005000726 0.0005817005 0.0005084621
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table5)
## $data
##
## Bachelors Masters Total
## Female 1184 389 1573
## Male 1140 275 1415
## Total 2324 664 2988
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.7344075 0.6163703 0.8740925
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.0005000726 0.0005817005 0.0005084621
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả phân tích so sánh giữa hai nhóm giới tính Male và Female và cho thấy:
Tỷ số odds (odds ratio) = 0.73, nghĩa là người có giới tính nam có khả năng có học vấn Masters thấp hơn khoảng 3.82% so với người có giới tính nữ.
Khoảng tin cậy 95% (0.62 đến 0.85) cho thấy mức độ chắc chắn: vì khoảng này không có chứa giá trị 1, ta thể kết luận chắc chắn rằng sự khác biệt là có thật.
Các giá trị p-value (mid-p = 0.0005, Fisher = 0.0005, Chi-square = 0.0005) đều bé hơn 0.05, tức đủ mạnh để bác bỏ giả thuyết rằng hai giới tính có cùng xác suất có học vấn Masters.
# Bần suất giữa Gender và Education
tanso6 <- table(data$Occupation, data$Education)
tansuat6 <- prop.table(tanso6, margin = 1) * 100
bang6 <- as.data.frame(tanso6)
bang6$Percentage <- round(as.vector(tansuat6), 2)
colnames(bang6) <- c("Occupation", "Education", "Tần số", "Tần suất")
kable(bang6, caption = "Bảng 13: Mô tả thống kê của 2 biến Occupation và Education")
| Occupation | Education | Tần số | Tần suất |
|---|---|---|---|
| Adm-clerical | 10th | 23 | 0.89 |
| Armed-Forces | 10th | 0 | 0.00 |
| Craft-repair | 10th | 56 | 4.06 |
| Exec-managerial | 10th | 6 | 0.39 |
| Farming-fishing | 10th | 21 | 5.75 |
| Handlers-cleaners | 10th | 39 | 4.94 |
| Machine-op-inspct | 10th | 52 | 5.73 |
| Other-service | 10th | 150 | 6.54 |
| Priv-house-serv | 10th | 5 | 4.46 |
| Prof-specialty | 10th | 8 | 0.43 |
| Protective-serv | 10th | 2 | 0.80 |
| Sales | 10th | 52 | 2.84 |
| Tech-support | 10th | 2 | 0.41 |
| Transport-moving | 10th | 27 | 4.88 |
| Adm-clerical | 11th | 52 | 2.02 |
| Armed-Forces | 11th | 0 | 0.00 |
| Craft-repair | 11th | 75 | 5.44 |
| Exec-managerial | 11th | 15 | 0.98 |
| Farming-fishing | 11th | 17 | 4.66 |
| Handlers-cleaners | 11th | 80 | 10.13 |
| Machine-op-inspct | 11th | 50 | 5.51 |
| Other-service | 11th | 179 | 7.81 |
| Priv-house-serv | 11th | 12 | 10.71 |
| Prof-specialty | 11th | 16 | 0.85 |
| Protective-serv | 11th | 5 | 2.00 |
| Sales | 11th | 115 | 6.27 |
| Tech-support | 11th | 4 | 0.82 |
| Transport-moving | 11th | 38 | 6.87 |
| Adm-clerical | 12th | 24 | 0.93 |
| Armed-Forces | 12th | 0 | 0.00 |
| Craft-repair | 12th | 17 | 1.23 |
| Exec-managerial | 12th | 7 | 0.46 |
| Farming-fishing | 12th | 11 | 3.01 |
| Handlers-cleaners | 12th | 30 | 3.80 |
| Machine-op-inspct | 12th | 22 | 2.42 |
| Other-service | 12th | 66 | 2.88 |
| Priv-house-serv | 12th | 3 | 2.68 |
| Prof-specialty | 12th | 6 | 0.32 |
| Protective-serv | 12th | 4 | 1.60 |
| Sales | 12th | 36 | 1.96 |
| Tech-support | 12th | 1 | 0.20 |
| Transport-moving | 12th | 17 | 3.07 |
| Adm-clerical | 1st-4th | 0 | 0.00 |
| Armed-Forces | 1st-4th | 0 | 0.00 |
| Craft-repair | 1st-4th | 6 | 0.44 |
| Exec-managerial | 1st-4th | 1 | 0.07 |
| Farming-fishing | 1st-4th | 7 | 1.92 |
| Handlers-cleaners | 1st-4th | 6 | 0.76 |
| Machine-op-inspct | 1st-4th | 9 | 0.99 |
| Other-service | 1st-4th | 15 | 0.65 |
| Priv-house-serv | 1st-4th | 9 | 8.04 |
| Prof-specialty | 1st-4th | 2 | 0.11 |
| Protective-serv | 1st-4th | 0 | 0.00 |
| Sales | 1st-4th | 2 | 0.11 |
| Tech-support | 1st-4th | 0 | 0.00 |
| Transport-moving | 1st-4th | 1 | 0.18 |
| Adm-clerical | 5th-6th | 2 | 0.08 |
| Armed-Forces | 5th-6th | 0 | 0.00 |
| Craft-repair | 5th-6th | 8 | 0.58 |
| Exec-managerial | 5th-6th | 0 | 0.00 |
| Farming-fishing | 5th-6th | 8 | 2.19 |
| Handlers-cleaners | 5th-6th | 16 | 2.03 |
| Machine-op-inspct | 5th-6th | 21 | 2.31 |
| Other-service | 5th-6th | 23 | 1.00 |
| Priv-house-serv | 5th-6th | 10 | 8.93 |
| Prof-specialty | 5th-6th | 0 | 0.00 |
| Protective-serv | 5th-6th | 0 | 0.00 |
| Sales | 5th-6th | 4 | 0.22 |
| Tech-support | 5th-6th | 1 | 0.20 |
| Transport-moving | 5th-6th | 8 | 1.45 |
| Adm-clerical | 7th-8th | 5 | 0.19 |
| Armed-Forces | 7th-8th | 0 | 0.00 |
| Craft-repair | 7th-8th | 26 | 1.89 |
| Exec-managerial | 7th-8th | 3 | 0.20 |
| Farming-fishing | 7th-8th | 21 | 5.75 |
| Handlers-cleaners | 7th-8th | 19 | 2.41 |
| Machine-op-inspct | 7th-8th | 39 | 4.30 |
| Other-service | 7th-8th | 55 | 2.40 |
| Priv-house-serv | 7th-8th | 7 | 6.25 |
| Prof-specialty | 7th-8th | 0 | 0.00 |
| Protective-serv | 7th-8th | 2 | 0.80 |
| Sales | 7th-8th | 8 | 0.44 |
| Tech-support | 7th-8th | 3 | 0.61 |
| Transport-moving | 7th-8th | 12 | 2.17 |
| Adm-clerical | 9th | 8 | 0.31 |
| Armed-Forces | 9th | 0 | 0.00 |
| Craft-repair | 9th | 30 | 2.18 |
| Exec-managerial | 9th | 3 | 0.20 |
| Farming-fishing | 9th | 8 | 2.19 |
| Handlers-cleaners | 9th | 22 | 2.78 |
| Machine-op-inspct | 9th | 29 | 3.19 |
| Other-service | 9th | 66 | 2.88 |
| Priv-house-serv | 9th | 9 | 8.04 |
| Prof-specialty | 9th | 2 | 0.11 |
| Protective-serv | 9th | 1 | 0.40 |
| Sales | 9th | 22 | 1.20 |
| Tech-support | 9th | 0 | 0.00 |
| Transport-moving | 9th | 11 | 1.99 |
| Adm-clerical | Assoc-acdm | 132 | 5.13 |
| Armed-Forces | Assoc-acdm | 0 | 0.00 |
| Craft-repair | Assoc-acdm | 48 | 3.48 |
| Exec-managerial | Assoc-acdm | 65 | 4.25 |
| Farming-fishing | Assoc-acdm | 3 | 0.82 |
| Handlers-cleaners | Assoc-acdm | 11 | 1.39 |
| Machine-op-inspct | Assoc-acdm | 15 | 1.65 |
| Other-service | Assoc-acdm | 58 | 2.53 |
| Priv-house-serv | Assoc-acdm | 1 | 0.89 |
| Prof-specialty | Assoc-acdm | 82 | 4.36 |
| Protective-serv | Assoc-acdm | 11 | 4.40 |
| Sales | Assoc-acdm | 72 | 3.93 |
| Tech-support | Assoc-acdm | 36 | 7.36 |
| Transport-moving | Assoc-acdm | 14 | 2.53 |
| Adm-clerical | Assoc-voc | 113 | 4.39 |
| Armed-Forces | Assoc-voc | 0 | 0.00 |
| Craft-repair | Assoc-voc | 75 | 5.44 |
| Exec-managerial | Assoc-voc | 64 | 4.19 |
| Farming-fishing | Assoc-voc | 15 | 4.11 |
| Handlers-cleaners | Assoc-voc | 9 | 1.14 |
| Machine-op-inspct | Assoc-voc | 26 | 2.86 |
| Other-service | Assoc-voc | 74 | 3.23 |
| Priv-house-serv | Assoc-voc | 4 | 3.57 |
| Prof-specialty | Assoc-voc | 92 | 4.89 |
| Protective-serv | Assoc-voc | 20 | 8.00 |
| Sales | Assoc-voc | 51 | 2.78 |
| Tech-support | Assoc-voc | 66 | 13.50 |
| Transport-moving | Assoc-voc | 12 | 2.17 |
| Adm-clerical | Bachelors | 314 | 12.19 |
| Armed-Forces | Bachelors | 1 | 20.00 |
| Craft-repair | Bachelors | 70 | 5.08 |
| Exec-managerial | Bachelors | 486 | 31.79 |
| Farming-fishing | Bachelors | 26 | 7.12 |
| Handlers-cleaners | Bachelors | 25 | 3.16 |
| Machine-op-inspct | Bachelors | 22 | 2.42 |
| Other-service | Bachelors | 110 | 4.80 |
| Priv-house-serv | Bachelors | 5 | 4.46 |
| Prof-specialty | Bachelors | 747 | 39.71 |
| Protective-serv | Bachelors | 35 | 14.00 |
| Sales | Bachelors | 340 | 18.55 |
| Tech-support | Bachelors | 125 | 25.56 |
| Transport-moving | Bachelors | 18 | 3.25 |
| Adm-clerical | Doctorate | 2 | 0.08 |
| Armed-Forces | Doctorate | 0 | 0.00 |
| Craft-repair | Doctorate | 1 | 0.07 |
| Exec-managerial | Doctorate | 13 | 0.85 |
| Farming-fishing | Doctorate | 0 | 0.00 |
| Handlers-cleaners | Doctorate | 0 | 0.00 |
| Machine-op-inspct | Doctorate | 1 | 0.11 |
| Other-service | Doctorate | 0 | 0.00 |
| Priv-house-serv | Doctorate | 0 | 0.00 |
| Prof-specialty | Doctorate | 90 | 4.78 |
| Protective-serv | Doctorate | 0 | 0.00 |
| Sales | Doctorate | 3 | 0.16 |
| Tech-support | Doctorate | 0 | 0.00 |
| Transport-moving | Doctorate | 0 | 0.00 |
| Adm-clerical | HS-grad | 920 | 35.73 |
| Armed-Forces | HS-grad | 3 | 60.00 |
| Craft-repair | HS-grad | 652 | 47.28 |
| Exec-managerial | HS-grad | 319 | 20.86 |
| Farming-fishing | HS-grad | 151 | 41.37 |
| Handlers-cleaners | HS-grad | 356 | 45.06 |
| Machine-op-inspct | HS-grad | 456 | 50.22 |
| Other-service | HS-grad | 864 | 37.68 |
| Priv-house-serv | HS-grad | 33 | 29.46 |
| Prof-specialty | HS-grad | 111 | 5.90 |
| Protective-serv | HS-grad | 82 | 32.80 |
| Sales | HS-grad | 526 | 28.70 |
| Tech-support | HS-grad | 76 | 15.54 |
| Transport-moving | HS-grad | 288 | 52.08 |
| Adm-clerical | Masters | 37 | 1.44 |
| Armed-Forces | Masters | 0 | 0.00 |
| Craft-repair | Masters | 4 | 0.29 |
| Exec-managerial | Masters | 156 | 10.20 |
| Farming-fishing | Masters | 2 | 0.55 |
| Handlers-cleaners | Masters | 3 | 0.38 |
| Machine-op-inspct | Masters | 2 | 0.22 |
| Other-service | Masters | 13 | 0.57 |
| Priv-house-serv | Masters | 0 | 0.00 |
| Prof-specialty | Masters | 376 | 19.99 |
| Protective-serv | Masters | 8 | 3.20 |
| Sales | Masters | 44 | 2.40 |
| Tech-support | Masters | 15 | 3.07 |
| Transport-moving | Masters | 4 | 0.72 |
| Adm-clerical | Preschool | 1 | 0.04 |
| Armed-Forces | Preschool | 0 | 0.00 |
| Craft-repair | Preschool | 1 | 0.07 |
| Exec-managerial | Preschool | 0 | 0.00 |
| Farming-fishing | Preschool | 6 | 1.64 |
| Handlers-cleaners | Preschool | 2 | 0.25 |
| Machine-op-inspct | Preschool | 5 | 0.55 |
| Other-service | Preschool | 8 | 0.35 |
| Priv-house-serv | Preschool | 1 | 0.89 |
| Prof-specialty | Preschool | 0 | 0.00 |
| Protective-serv | Preschool | 0 | 0.00 |
| Sales | Preschool | 0 | 0.00 |
| Tech-support | Preschool | 0 | 0.00 |
| Transport-moving | Preschool | 0 | 0.00 |
| Adm-clerical | Prof-school | 2 | 0.08 |
| Armed-Forces | Prof-school | 0 | 0.00 |
| Craft-repair | Prof-school | 1 | 0.07 |
| Exec-managerial | Prof-school | 12 | 0.78 |
| Farming-fishing | Prof-school | 1 | 0.27 |
| Handlers-cleaners | Prof-school | 0 | 0.00 |
| Machine-op-inspct | Prof-school | 0 | 0.00 |
| Other-service | Prof-school | 3 | 0.13 |
| Priv-house-serv | Prof-school | 0 | 0.00 |
| Prof-specialty | Prof-school | 123 | 6.54 |
| Protective-serv | Prof-school | 0 | 0.00 |
| Sales | Prof-school | 4 | 0.22 |
| Tech-support | Prof-school | 5 | 1.02 |
| Transport-moving | Prof-school | 0 | 0.00 |
| Adm-clerical | Some-college | 940 | 36.50 |
| Armed-Forces | Some-college | 1 | 20.00 |
| Craft-repair | Some-college | 309 | 22.41 |
| Exec-managerial | Some-college | 379 | 24.79 |
| Farming-fishing | Some-college | 68 | 18.63 |
| Handlers-cleaners | Some-college | 172 | 21.77 |
| Machine-op-inspct | Some-college | 159 | 17.51 |
| Other-service | Some-college | 609 | 26.56 |
| Priv-house-serv | Some-college | 13 | 11.61 |
| Prof-specialty | Some-college | 226 | 12.01 |
| Protective-serv | Some-college | 80 | 32.00 |
| Sales | Some-college | 554 | 30.22 |
| Tech-support | Some-college | 155 | 31.70 |
| Transport-moving | Some-college | 103 | 18.63 |
#Trực quan hóa cho mối quan hệ giữa 2 biến
ggplot(data, aes(x = Education, fill = Occupation)) +
geom_bar(position = "dodge") +
labs(
title = "Hình 13: Mối quan hệ giữa Occupation và Education",
x = "Học vấn",
y = "Số lượng",
fill = "Nghề nghiệp"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Biểu đồ và bảng thống kê cho thấy sự phân bố nghề nghiệp khác nhau rõ rệt theo trình độ học vấn. Ở bậc HS-grad và Some-college, các nhóm nghề như Adm-clerical (920 và 940 người), Sales (526 và 554) và Other-service (864 và 609) chiếm tỷ lệ cao. Nghề chuyên môn cao (Prof-specialty) tập trung chủ yếu ở bậc Bachelors (747 người) và Masters (376 người). Trong khi đó, các nhóm lao động tay chân như Handlers-cleaners, Machine-op-inspct và Craft-repair phổ biến hơn ở nhóm học vấn phổ thông và trung cấp. Các nghề như Exec-managerial và Tech-support cũng tăng rõ ở bậc Bachelors và Some-college. Nhìn chung, nghề nghiệp có xu hướng phân hóa mạnh theo học vấn, với các nghề kỹ thuật và chuyên môn tập trung ở nhóm có học vấn cao.
Giả thuyết kiểm định:
\(H_0\): Biến Occupation (nghề nghiệp) không ảnh hưởng đến biến Education (học vấn)
\(H_1\): Biến Occupation (nghề nghiệp) có ảnh hưởng đến biến Education (học vấn)
# Kiểm định Chi-bình phương
chi_test <- chisq.test(tanso6)
## Warning in chisq.test(tanso6): Chi-squared approximation may be incorrect
chi_test
##
## Pearson's Chi-squared test
##
## data: tanso6
## X-squared = 7257.9, df = 195, p-value < 2.2e-16
Với kết quả vừa kiểm định được, ta thấy rằng \(p-value < 2.2e-16 < 0.05\), ta bác bỏ giả thuyết \(H_0\) và chấp nhận giả thuyết \(H_1\), tức biến Occupation (nghề nghiệp) có ảnh hưởng đến biến Education (học vấn) ở mức ý nghĩa 5%.
Để tính RR và OR chúng ta sẽ giới hạn hạng mục quan tâm. Vì ta cần quan tâm các biến tác động đến thu nhập như thế nào nên ta sẽ giữ nguyên 2 hạng mục của biến Education là Bachelors và Masters. Với biến Occupation, hạng mục quan tâm Sales và Transport-moving.
library(epitools)
# Làm sạch dữ liệu trước nếu cần
data$Occupation <- trimws(data$Occupation)
data$Education <- trimws(data$Education)
# Lọc ra những hàng có Occupation và Education như yêu cầu
tsc6 <- subset(data,
Occupation %in% c("Sales", "Transport-moving") &
Education %in% c("Bachelors", "Masters"))
# Bỏ levels không còn sử dụng (nếu biến là factor)
tsc6 <- droplevels(tsc6)
table6 <- table(tsc6$Occupation, tsc6$Education)
kable (table6)
| Bachelors | Masters | |
|---|---|---|
| Sales | 340 | 44 |
| Transport-moving | 18 | 4 |
#Tính RR
riskratio(table6)
## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect
## $data
##
## Bachelors Masters Total
## Sales 340 44 384
## Transport-moving 18 4 22
## Total 358 48 406
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Sales 1.000000 NA NA
## Transport-moving 1.586777 0.6266903 4.017711
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Sales NA NA NA
## Transport-moving 0.3588146 0.3128613 0.3421693
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
#Tính OR
oddsratio(table6)
## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect
## $data
##
## Bachelors Masters Total
## Sales 340 44 384
## Transport-moving 18 4 22
## Total 358 48 406
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Sales 1.00000 NA NA
## Transport-moving 1.76253 0.4782936 5.036821
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Sales NA NA NA
## Transport-moving 0.3588146 0.3128613 0.3421693
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả phân tích so sánh giữa hai nhóm nghề nghiệp Sales và Transport-moving và cho thấy:
Tỷ số odds (odds ratio) = 1.59, nghĩa là người có nghề nghiệp là Transport-moving có khả năng có học vấn Masters cao hơn khoảng 0.72% so với người có nghề Sales.
Khoảng tin cậy 95% (0.62 đến 4.02) cho thấy mức độ chắc chắn: vì khoảng này không có chứa giá trị 1, ta thể kết luận chắc chắn rằng sự khác biệt là có thật.
Các giá trị p-value (mid-p = 0.36, Fisher = 0.31, Chi-square = 0.34) đều lớn hơn 0.05, tức chưa đủ mạnh để bác bỏ giả thuyết rằng hai nghề nghiệp có cùng xác suất có học vấn Masters.
với phần này, tác giả chọn biến phụ thuộc là biến Income.
#Chuyển biến Income sang nhị phân
data$Income.np <- ifelse(data$Income == ">50K", 1, 0)
# Ước lượng mô hình logit (link = "logit")
logit <- glm(Income.np ~ WorkClass + Education + MaritalStatus + Occupation + Gender + Country, data = data, family = binomial(link = "logit"))
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(logit)
##
## Call:
## glm(formula = Income.np ~ WorkClass + Education + MaritalStatus +
## Occupation + Gender + Country, family = binomial(link = "logit"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -19.18844 1693.13033 -0.011 0.99096
## WorkClassLocal-gov -0.79494 0.20044 -3.966 7.31e-05 ***
## WorkClassPrivate -0.42249 0.16281 -2.595 0.00946 **
## WorkClassSelf-emp-inc 0.01456 0.23821 0.061 0.95127
## WorkClassSelf-emp-not-inc -0.25011 0.20146 -1.241 0.21443
## WorkClassState-gov -1.11571 0.23135 -4.823 1.42e-06 ***
## WorkClassWithout-pay -13.92685 1736.60233 -0.008 0.99360
## Education11th 0.51655 0.46971 1.100 0.27146
## Education12th 0.11280 0.64304 0.175 0.86075
## Education1st-4th -13.22702 485.08195 -0.027 0.97825
## Education5th-6th -13.02164 369.53739 -0.035 0.97189
## Education7th-8th 0.13132 0.64635 0.203 0.83900
## Education9th 0.64261 0.57453 1.118 0.26335
## EducationAssoc-acdm 1.06895 0.42990 2.486 0.01290 *
## EducationAssoc-voc 1.13544 0.42350 2.681 0.00734 **
## EducationBachelors 1.89441 0.39851 4.754 2.00e-06 ***
## EducationDoctorate 3.96093 0.45121 8.778 < 2e-16 ***
## EducationHS-grad 0.45107 0.39747 1.135 0.25644
## EducationMasters 2.56064 0.40737 6.286 3.26e-10 ***
## EducationPreschool -12.63533 738.17976 -0.017 0.98634
## EducationProf-school 3.45723 0.43645 7.921 2.35e-15 ***
## EducationSome-college 0.72623 0.39933 1.819 0.06897 .
## MaritalStatusNever-married -0.98786 0.07952 -12.423 < 2e-16 ***
## MaritalStatusSeparated -0.23349 0.15586 -1.498 0.13413
## MaritalStatusWidowed 0.41570 0.14666 2.834 0.00459 **
## OccupationArmed-Forces -14.49691 1722.82327 -0.008 0.99329
## OccupationCraft-repair 0.55168 0.17950 3.074 0.00212 **
## OccupationExec-managerial 1.40650 0.14769 9.523 < 2e-16 ***
## OccupationFarming-fishing -0.14636 0.34600 -0.423 0.67229
## OccupationHandlers-cleaners -1.38295 0.47082 -2.937 0.00331 **
## OccupationMachine-op-inspct -0.83426 0.34715 -2.403 0.01625 *
## OccupationOther-service -0.67070 0.23573 -2.845 0.00444 **
## OccupationPriv-house-serv -0.66313 1.02781 -0.645 0.51880
## OccupationProf-specialty 0.88540 0.15425 5.740 9.46e-09 ***
## OccupationProtective-serv 1.33699 0.25077 5.332 9.74e-08 ***
## OccupationSales 0.74109 0.16106 4.601 4.20e-06 ***
## OccupationTech-support 0.62867 0.22083 2.847 0.00442 **
## OccupationTransport-moving 0.46553 0.24208 1.923 0.05447 .
## GenderMale 0.89374 0.07959 11.230 < 2e-16 ***
## Country Canada 13.37564 1693.13062 0.008 0.99370
## Country China 14.84366 1693.13063 0.009 0.99301
## Country Columbia 14.73812 1693.13068 0.009 0.99305
## Country Cuba 13.60207 1693.13062 0.008 0.99359
## Country Dominican-Republic 15.08807 1693.13069 0.009 0.99289
## Country Ecuador 2.10949 2198.85830 0.001 0.99923
## Country El-Salvador 14.76200 1693.13072 0.009 0.99304
## Country England 15.73794 1693.13035 0.009 0.99258
## Country France 15.59912 1693.13046 0.009 0.99265
## Country Germany 15.27945 1693.13035 0.009 0.99280
## Country Greece 17.65283 1693.13052 0.010 0.99168
## Country Guatemala 16.29688 1693.13063 0.010 0.99232
## Country Haiti 1.36287 1910.60104 0.001 0.99943
## Country Honduras 0.81716 2155.80366 0.000 0.99970
## Country Hong 0.47375 2495.04737 0.000 0.99985
## Country Hungary 15.37718 1693.13067 0.009 0.99275
## Country India 15.61051 1693.13038 0.009 0.99264
## Country Iran 14.00433 1693.13052 0.008 0.99340
## Country Ireland 15.39642 1693.13065 0.009 0.99274
## Country Italy 16.75228 1693.13043 0.010 0.99211
## Country Jamaica 0.95103 1780.67277 0.001 0.99957
## Country Japan 15.53866 1693.13045 0.009 0.99268
## Country Laos 1.65127 2257.99323 0.001 0.99942
## Country Mexico 15.30481 1693.13035 0.009 0.99279
## Country Nicaragua 1.28493 1933.70618 0.001 0.99947
## Country Outlying-US(Guam-USVI-etc) 0.35246 2027.72521 0.000 0.99986
## Country Peru 1.40798 1900.90078 0.001 0.99941
## Country Philippines 15.62193 1693.13035 0.009 0.99264
## Country Poland 15.13533 1693.13062 0.009 0.99287
## Country Portugal 15.87979 1693.13065 0.009 0.99252
## Country Puerto-Rico 15.86611 1693.13041 0.009 0.99252
## Country Scotland -0.26941 2225.36575 0.000 0.99990
## Country South 14.98791 1693.13047 0.009 0.99294
## Country Taiwan 15.01750 1693.13049 0.009 0.99292
## Country Thailand 0.07057 2082.11052 0.000 0.99997
## Country Trinadad&Tobago 0.45660 2068.53973 0.000 0.99982
## Country United-States 15.27885 1693.13029 0.009 0.99280
## Country Vietnam 15.08514 1693.13062 0.009 0.99289
## Country Yugoslavia 1.07209 2552.26185 0.000 0.99966
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 7614.0 on 14961 degrees of freedom
## Residual deviance: 5803.7 on 14884 degrees of freedom
## AIC: 5959.7
##
## Number of Fisher Scoring iterations: 16
Kết quả cho thấy giới tính ảnh hưởng rõ rệt đến mức thu nhập, với nam giới có khả năng đạt thu nhập trên 50K cao hơn nữ giới. Cụ thể, hệ số của biến GenderMale là 0.89, nghĩa là nam giới có lợi thế thu nhập rõ rệt, có thể phản ánh chênh lệch giới trong cơ hội nghề nghiệp hoặc mức lương trên thị trường lao động.
Trình độ học vấn là yếu tố then chốt về kinh tế. Những người có bằng đại học (Bachelors: hệ số 1.89), thạc sĩ (Masters: 2.56), tiến sĩ (Doctorate: 3.96) hay tốt nghiệp trường chuyên môn (Prof-school: 3.46) đều có xác suất thu nhập cao hơn hẳn. Điều này cho thấy giá trị kinh tế của giáo dục bậc cao rất lớn, và đầu tư vào học vấn thực sự mang lại lợi ích tài chính đáng kể.
Tình trạng hôn nhân cũng liên quan đến thu nhập. Người chưa kết hôn (Never-married: -0.99) có khả năng thu nhập cao thấp hơn người đã kết hôn. Điều này có thể phản ánh rằng người kết hôn thường ổn định hơn về mặt xã hội và kinh tế, hoặc họ chọn lựa công việc/lộ trình nghề nghiệp khác với người độc thân.
Về nghề nghiệp, nhóm Exec-managerial (1.41) và Prof-specialty (0.88) là những nghề có hệ số dương lớn, cho thấy đây là những ngành nghề có giá trị kinh tế cao, thường yêu cầu kỹ năng và trình độ cao. Ngược lại, những nghề như lao động phổ thông, dịch vụ (Handlers-cleaners: -1.38) có hệ số âm rõ rệt, phản ánh thu nhập thấp gắn với công việc không đòi hỏi trình độ chuyên môn cao.
Ở góc độ loại hình công việc, những người làm trong khu vực nhà nước (Local-gov: -0.79, State-gov: -1.11) có xu hướng thu nhập thấp hơn khu vực tư nhân, phản ánh mức lương trong khu vực công thường ổn định nhưng thấp hơn thị trường, hoặc ít có cơ hội thưởng và tăng lương.
Cuối cùng, biến Country cho thấy nhiều hệ số cực cao với sai số chuẩn lớn và p-value không có ý nghĩa thống kê, phản ánh mô hình không rút ra được thông tin kinh tế đáng tin cậy từ quốc tịch – có thể do dữ liệu không đồng đều giữa các quốc gia. Về mặt kinh tế, điều này cho thấy cần có thêm dữ liệu hoặc gộp nhóm lại để phân tích có giá trị hơn.
#Chuyển biến Income sang nhị phân
data$Income.np <- ifelse(data$Income == ">50K", 1, 0)
# Ước lượng mô hình probit (link = "probit")
probit <- glm(Income.np ~ WorkClass + Education + MaritalStatus + Occupation + Gender + Country, data = data, family = binomial(link = "logit"))
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(probit)
##
## Call:
## glm(formula = Income.np ~ WorkClass + Education + MaritalStatus +
## Occupation + Gender + Country, family = binomial(link = "logit"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -19.18844 1693.13033 -0.011 0.99096
## WorkClassLocal-gov -0.79494 0.20044 -3.966 7.31e-05 ***
## WorkClassPrivate -0.42249 0.16281 -2.595 0.00946 **
## WorkClassSelf-emp-inc 0.01456 0.23821 0.061 0.95127
## WorkClassSelf-emp-not-inc -0.25011 0.20146 -1.241 0.21443
## WorkClassState-gov -1.11571 0.23135 -4.823 1.42e-06 ***
## WorkClassWithout-pay -13.92685 1736.60233 -0.008 0.99360
## Education11th 0.51655 0.46971 1.100 0.27146
## Education12th 0.11280 0.64304 0.175 0.86075
## Education1st-4th -13.22702 485.08195 -0.027 0.97825
## Education5th-6th -13.02164 369.53739 -0.035 0.97189
## Education7th-8th 0.13132 0.64635 0.203 0.83900
## Education9th 0.64261 0.57453 1.118 0.26335
## EducationAssoc-acdm 1.06895 0.42990 2.486 0.01290 *
## EducationAssoc-voc 1.13544 0.42350 2.681 0.00734 **
## EducationBachelors 1.89441 0.39851 4.754 2.00e-06 ***
## EducationDoctorate 3.96093 0.45121 8.778 < 2e-16 ***
## EducationHS-grad 0.45107 0.39747 1.135 0.25644
## EducationMasters 2.56064 0.40737 6.286 3.26e-10 ***
## EducationPreschool -12.63533 738.17976 -0.017 0.98634
## EducationProf-school 3.45723 0.43645 7.921 2.35e-15 ***
## EducationSome-college 0.72623 0.39933 1.819 0.06897 .
## MaritalStatusNever-married -0.98786 0.07952 -12.423 < 2e-16 ***
## MaritalStatusSeparated -0.23349 0.15586 -1.498 0.13413
## MaritalStatusWidowed 0.41570 0.14666 2.834 0.00459 **
## OccupationArmed-Forces -14.49691 1722.82327 -0.008 0.99329
## OccupationCraft-repair 0.55168 0.17950 3.074 0.00212 **
## OccupationExec-managerial 1.40650 0.14769 9.523 < 2e-16 ***
## OccupationFarming-fishing -0.14636 0.34600 -0.423 0.67229
## OccupationHandlers-cleaners -1.38295 0.47082 -2.937 0.00331 **
## OccupationMachine-op-inspct -0.83426 0.34715 -2.403 0.01625 *
## OccupationOther-service -0.67070 0.23573 -2.845 0.00444 **
## OccupationPriv-house-serv -0.66313 1.02781 -0.645 0.51880
## OccupationProf-specialty 0.88540 0.15425 5.740 9.46e-09 ***
## OccupationProtective-serv 1.33699 0.25077 5.332 9.74e-08 ***
## OccupationSales 0.74109 0.16106 4.601 4.20e-06 ***
## OccupationTech-support 0.62867 0.22083 2.847 0.00442 **
## OccupationTransport-moving 0.46553 0.24208 1.923 0.05447 .
## GenderMale 0.89374 0.07959 11.230 < 2e-16 ***
## Country Canada 13.37564 1693.13062 0.008 0.99370
## Country China 14.84366 1693.13063 0.009 0.99301
## Country Columbia 14.73812 1693.13068 0.009 0.99305
## Country Cuba 13.60207 1693.13062 0.008 0.99359
## Country Dominican-Republic 15.08807 1693.13069 0.009 0.99289
## Country Ecuador 2.10949 2198.85830 0.001 0.99923
## Country El-Salvador 14.76200 1693.13072 0.009 0.99304
## Country England 15.73794 1693.13035 0.009 0.99258
## Country France 15.59912 1693.13046 0.009 0.99265
## Country Germany 15.27945 1693.13035 0.009 0.99280
## Country Greece 17.65283 1693.13052 0.010 0.99168
## Country Guatemala 16.29688 1693.13063 0.010 0.99232
## Country Haiti 1.36287 1910.60104 0.001 0.99943
## Country Honduras 0.81716 2155.80366 0.000 0.99970
## Country Hong 0.47375 2495.04737 0.000 0.99985
## Country Hungary 15.37718 1693.13067 0.009 0.99275
## Country India 15.61051 1693.13038 0.009 0.99264
## Country Iran 14.00433 1693.13052 0.008 0.99340
## Country Ireland 15.39642 1693.13065 0.009 0.99274
## Country Italy 16.75228 1693.13043 0.010 0.99211
## Country Jamaica 0.95103 1780.67277 0.001 0.99957
## Country Japan 15.53866 1693.13045 0.009 0.99268
## Country Laos 1.65127 2257.99323 0.001 0.99942
## Country Mexico 15.30481 1693.13035 0.009 0.99279
## Country Nicaragua 1.28493 1933.70618 0.001 0.99947
## Country Outlying-US(Guam-USVI-etc) 0.35246 2027.72521 0.000 0.99986
## Country Peru 1.40798 1900.90078 0.001 0.99941
## Country Philippines 15.62193 1693.13035 0.009 0.99264
## Country Poland 15.13533 1693.13062 0.009 0.99287
## Country Portugal 15.87979 1693.13065 0.009 0.99252
## Country Puerto-Rico 15.86611 1693.13041 0.009 0.99252
## Country Scotland -0.26941 2225.36575 0.000 0.99990
## Country South 14.98791 1693.13047 0.009 0.99294
## Country Taiwan 15.01750 1693.13049 0.009 0.99292
## Country Thailand 0.07057 2082.11052 0.000 0.99997
## Country Trinadad&Tobago 0.45660 2068.53973 0.000 0.99982
## Country United-States 15.27885 1693.13029 0.009 0.99280
## Country Vietnam 15.08514 1693.13062 0.009 0.99289
## Country Yugoslavia 1.07209 2552.26185 0.000 0.99966
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 7614.0 on 14961 degrees of freedom
## Residual deviance: 5803.7 on 14884 degrees of freedom
## AIC: 5959.7
##
## Number of Fisher Scoring iterations: 16
Giới tính: Nam giới có lợi thế rõ rệt—hệ số 0.89, p < 0.001—nghĩa là sau khi kiểm soát các yếu tố khác, nam có xác suất vượt mốc 50 K cao hơn nữ.
Học vấn: Giá trị kinh tế của giáo dục rất lớn. Cử nhân (1.89, p ≈ 2 × 10‑6), thạc sĩ (2.56, p ≈ 3 × 10‑10) và đặc biệt tiến sĩ (3.96, p < 2 × 10‑16) đều tăng mạnh cơ hội thu nhập cao; trình độ càng cao, xác suất càng lớn.
Nghề nghiệp: Các vị trí chuyên môn/ quản lý mang lại thu nhập tốt—exec‑managerial (1.41, p < 2 × 10‑16), prof‑specialty (0.89, p ≈ 9 × 10‑9), protective‑service (1.34, p ≈ 1 × 10‑7). Ngược lại, lao động phổ thông như handlers‑cleaners (‑1.38, p ≈ 0.003) làm giảm đáng kể cơ hội.
Loại hình công việc: Làm khu vực công kéo thu nhập xuống; state‑gov (‑1.12, p ≈ 1 × 10‑6) và local‑gov (‑0.79, p ≈ 7 × 10‑5) đều giảm xác suất so với nhóm tham chiếu tư nhân.
Tình trạng hôn nhân: Người chưa từng kết hôn chịu bất lợi—hệ số ‑0.99, p < 2 × 10‑16—hàm ý ổn định gia đình có liên quan tới mức lương cao.
Quốc tịch: Hệ số cực lớn (≈ 13–17) nhưng p‑value ≈ 1 và sai số chuẩn khổng lồ cho thấy biến Country không hữu ích; cần gộp nhóm hoặc loại bỏ vì mất cân bằng dữ liệu.
Tóm lại, đầu tư vào giáo dục cao, chọn nghề chuyên môn hoặc quản lý, làm việc khu vực tư nhân và ổn định hôn nhân là các “đòn bẩy” kinh tế lớn nhất giúp cá nhân vươn tới thu nhập trên 50 K.