Nhiệm vụ Tuần 04

1 Đọc và làm quen dữ liệu

• Bộ dữ liệu Adult Income (hay còn gọi là Census Income Dataset) là một trong những tập dữ liệu kinh điển được sử dụng phổ biến trong lĩnh vực học máy và khai phá dữ liệu, đặc biệt trong các bài toán phân loại. Tập dữ liệu này được cung cấp bởi UCI Machine Learning Repository, và bao gồm các thông tin định lượng và định tính liên quan đến hơn 32.000 cá nhân trưởng thành tại Hoa Kỳ.

• Dữ liệu được thu thập từ các cuộc khảo sát dân số (census) và phản ánh đặc điểm nhân khẩu học như tuổi tác, giới tính, chủng tộc, tình trạng hôn nhân, cùng với các yếu tố kinh tế – xã hội như trình độ học vấn, loại hình công việc, số giờ làm việc mỗi tuần, thu nhập từ vốn và quốc tịch.

• Mục tiêu phân tích của bộ dữ liệu này là xây dựng một mô hình dự đoán xem một cá nhân có mức thu nhập hằng năm vượt ngưỡng 50.000 USD hay không, dựa trên tập hợp các biến đầu vào đã cho. Nói cách khác, đây là một bài toán phân loại nhị phân, nơi biến mục tiêu là một nhãn với hai giá trị: <=50K và >50K.

• Với cấu trúc đơn giản nhưng giàu thông tin, bộ dữ liệu Adult thường được sử dụng như một ví dụ điển hình để thực hành các kỹ thuật tiền xử lý dữ liệu, biến đổi đặc trưng, huấn luyện mô hình học máy, và đánh giá độ chính xác của mô hình trong các khóa học và dự án nghiên cứu.

1.1 Đọc file

d <-read.csv('/Users/phamxuanhoan/Documents/Zalo Received Files/dldt.csv', header=T)

1.2 Hiển thị cấu trúc của dữ liệu

str(d)

## 'data.frame':    32561 obs. of  12 variables:
##  $ age           : int  90 82 66 54 41 34 38 74 68 41 ...
##  $ fnlwgt        : int  77053 132870 186061 140359 264663 216864 150601 88638 422013 70037 ...
##  $ education     : chr  "HS-grad" "HS-grad" "Some-college" "7th-8th" ...
##  $ education.num : int  9 9 10 4 10 9 6 16 9 10 ...
##  $ marital.status: chr  "Widowed" "Widowed" "Widowed" "Divorced" ...
##  $ relationship  : chr  "Not-in-family" "Not-in-family" "Unmarried" "Unmarried" ...
##  $ race          : chr  "White" "White" "Black" "White" ...
##  $ sex           : chr  "Female" "Female" "Female" "Female" ...
##  $ capital.loss  : int  4356 4356 4356 3900 3900 3770 3770 3683 3683 3004 ...
##  $ hours.per.week: int  40 18 40 40 40 45 40 20 40 60 ...
##  $ native.country: chr  "United-States" "United-States" "United-States" "United-States" ...
##  $ income        : chr  "<=50K" "<=50K" "<=50K" "<=50K" ...

• str(...) là viết tắt của structure – dùng để kiểm tra nhanh thông tin về số dòng, số cột, tên biến và kiểu dữ liệu của từng biến.

• Khi dùng str(d), bạn sẽ biết được:

• d có bao nhiêu quan sát (rows) và biến (columns)

• Tên của các biến

• Kiểu dữ liệu của từng biến (vd: int, chr, factor, num…)

=> Dữ liệu bao gồm: 32561 quan sát và 12 biến, trong đó có 7 biến định tính

variable_explain <- data.frame(
  Ten_Bien = c("age", "fnlwgt", "education", "education.num", "marital.status", 
               "relationship", "race", "sex", "capital.loss", "hours.per.week", 
               "native.country", "income"),
  Y_Nghia = c(
    "Tuổi của cá nhân",
    "Trọng số mẫu dùng cho khảo sát (final weight)",
    "Trình độ học vấn (ví dụ: HS-grad, Some-college)",
    "Số năm học chính quy tương ứng với education",
    "Tình trạng hôn nhân (Divorced, Married, Widowed, v.v.)",
    "Mối quan hệ trong gia đình (Own-child, Not-in-family...)",
    "Chủng tộc (White, Black, Asian-Pac-Islander...)",
    "Giới tính (Male hoặc Female)",
    "Mức lỗ vốn từ đầu tư (capital loss)",
    "Số giờ làm việc mỗi tuần",
    "Quốc gia xuất xứ (ví dụ: United-States)",
    "Thu nhập (<=50K hoặc >50K USD/năm)"
  )
)

library(knitr)

## Warning: package 'knitr' was built under R version 4.3.3

kable(variable_explain, caption = "Giải thích các biến trong bộ dữ liệu")

Giải thích các biến trong bộ dữ liệu

Ten_Bien	Y_Nghia
age	Tuổi của cá nhân
fnlwgt	Trọng số mẫu dùng cho khảo sát (final weight)
education	Trình độ học vấn (ví dụ: HS-grad, Some-college)
education.num	Số năm học chính quy tương ứng với education
marital.status	Tình trạng hôn nhân (Divorced, Married, Widowed, v.v.)
relationship	Mối quan hệ trong gia đình (Own-child, Not-in-family…)
race	Chủng tộc (White, Black, Asian-Pac-Islander…)
sex	Giới tính (Male hoặc Female)
capital.loss	Mức lỗ vốn từ đầu tư (capital loss)
hours.per.week	Số giờ làm việc mỗi tuần
native.country	Quốc gia xuất xứ (ví dụ: United-States)
income	Thu nhập (<=50K hoặc >50K USD/năm)

1.3 Kiểm tra giá trị thiếu

sum(is.na(d))

## [1] 0

=> Kết quả: Trong bộ dữ liệu không có giá trị thiếu (NA).

1.4 Chuyển đổi các biến cần thiết

# Danh sách các biến định tính (categorical variables)
cols_to_factor <- c("education", "marital.status", "relationship",
                    "race", "sex", "native.country", "income")

# Chuyển các cột đó sang factor
d[cols_to_factor] <- lapply(d[cols_to_factor], as.factor)

# Kiểm tra lại cấu trúc dữ liệu
str(d)

## 'data.frame':    32561 obs. of  12 variables:
##  $ age           : int  90 82 66 54 41 34 38 74 68 41 ...
##  $ fnlwgt        : int  77053 132870 186061 140359 264663 216864 150601 88638 422013 70037 ...
##  $ education     : Factor w/ 16 levels "10th","11th",..: 12 12 16 6 16 12 1 11 12 16 ...
##  $ education.num : int  9 9 10 4 10 9 6 16 9 10 ...
##  $ marital.status: Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 7 7 7 1 6 1 6 5 1 5 ...
##  $ relationship  : Factor w/ 6 levels "Husband","Not-in-family",..: 2 2 5 5 4 5 5 3 2 5 ...
##  $ race          : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 5 5 3 5 5 5 5 5 5 5 ...
##  $ sex           : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 2 1 1 2 ...
##  $ capital.loss  : int  4356 4356 4356 3900 3900 3770 3770 3683 3683 3004 ...
##  $ hours.per.week: int  40 18 40 40 40 45 40 20 40 60 ...
##  $ native.country: Factor w/ 42 levels "?","Cambodia",..: 40 40 40 40 40 40 40 40 40 1 ...
##  $ income        : Factor w/ 2 levels "<=50K",">50K": 1 1 1 1 1 1 1 2 1 2 ...

Các biến định tính như:

• education: có 16 mức trình độ học vấn khác nhau (ví dụ: HS-grad, Bachelors, Some-college…)

• marital.status: gồm các mức như Married, Divorced, Widowed, Separated, Never-married

• relationship: mô tả mối quan hệ trong gia đình, như Own-child, Not-in-family, Husband, Wife…

• race: 5 nhóm chủng tộc

• sex: 2 mức (Male, Female)

• native.country: trên 30 quốc gia khác nhau (đa số là United-States)

• income: 2 mức (<=50K, >50K)

2 Phân tích Mô tả Một biến Định tính (Univariate Descriptive Analysis)

# Danh sách biến định tính thực tế trong file
tbdt <- c("education", "marital.status", "relationship",
          "race", "sex", "native.country", "income")

# Tạo bảng con chỉ gồm các biến định tính
dq <- d[, tbdt]

# Kiểm tra
str(dq)

## 'data.frame':    32561 obs. of  7 variables:
##  $ education     : Factor w/ 16 levels "10th","11th",..: 12 12 16 6 16 12 1 11 12 16 ...
##  $ marital.status: Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 7 7 7 1 6 1 6 5 1 5 ...
##  $ relationship  : Factor w/ 6 levels "Husband","Not-in-family",..: 2 2 5 5 4 5 5 3 2 5 ...
##  $ race          : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 5 5 3 5 5 5 5 5 5 5 ...
##  $ sex           : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 2 1 1 2 ...
##  $ native.country: Factor w/ 42 levels "?","Cambodia",..: 40 40 40 40 40 40 40 40 40 1 ...
##  $ income        : Factor w/ 2 levels "<=50K",">50K": 1 1 1 1 1 1 1 2 1 2 ...

• Đây là danh sách (vector) chứa tên các cột – đều là biến định tính.

• Lấy toàn bộ các cột trong danh sách tbdt từ bảng dữ liệu d, và tạo ra một bảng mới tên là dq.

=> Kết quả là bảng dq chỉ chứa các biến định tính.

2.1 Biến MaritalStatus

2.1.1 Giải thích biến

# Giải thích các mức của biến marital.status
marital_levels <- data.frame(
  Gia_tri = c("Divorced", "Married-AF-spouse", "Married-civ-spouse",
              "Married-spouse-absent", "Never-married", "Separated", "Widowed"),
  Y_nghia = c(
    "Ly dị",
    "Kết hôn với người trong lực lượng vũ trang",
    "Đã kết hôn hợp pháp",
    "Kết hôn nhưng sống ly thân",
    "Chưa từng kết hôn",
    "Ly thân có pháp lý",
    "Góa"
  )
)

knitr::kable(marital_levels, caption = "Giải thích các mức trong biến marital.status")

Giải thích các mức trong biến marital.status

Gia_tri	Y_nghia
Divorced	Ly dị
Married-AF-spouse	Kết hôn với người trong lực lượng vũ trang
Married-civ-spouse	Đã kết hôn hợp pháp
Married-spouse-absent	Kết hôn nhưng sống ly thân
Never-married	Chưa từng kết hôn
Separated	Ly thân có pháp lý
Widowed	Góa

2.1.2 Thống kê Tần suất

# Tạo bảng tần suất cho marital.status
ts_marital <- table(d$marital.status)

# Tạo bảng dữ liệu
ts_marital_df <- data.frame(
  Gia_tri = names(ts_marital),
  Tan_so = as.vector(ts_marital),
  Ty_le = round((as.vector(ts_marital) / sum(ts_marital)) * 100, 2)
)

# Hiển thị kết quả
ts_marital_df

##                 Gia_tri Tan_so Ty_le
## 1              Divorced   4443 13.65
## 2     Married-AF-spouse     23  0.07
## 3    Married-civ-spouse  14976 45.99
## 4 Married-spouse-absent    418  1.28
## 5         Never-married  10683 32.81
## 6             Separated   1025  3.15
## 7               Widowed    993  3.05

• Đã ly dị (Divorced): có 4443 người (chiếm 13.65%).

• Kết hôn với người trong quân đội (Married-AF-spouse): có 23 người (chiếm 0.07%).

• Đã kết hôn hợp pháp (Married-civ-spouse): có 14976 người (chiếm 45.99%).

• Ly thân (Married-spouse-absent): có 418 người (chiếm 1.28%).

• Chưa từng kết hôn (Never-married): có 10683 người (chiếm 32.81%).

• Ly thân có pháp lý (Separated): có 1025 người (chiếm 3.15%).

• Góa (Widowed): có 993 người (chiếm 3.05%).

2.1.3 Trực quan hóa

library(ggplot2)
ggplot(ts_marital_df, aes(x = reorder(Gia_tri, -Tan_so), y = Tan_so, fill = Gia_tri)) +
  geom_col(width = 0.5, color = "white") +
  geom_text(aes(label = Tan_so), vjust = -0.3, size = 4, fontface = "bold") +
  labs(
    title = "Biểu đồ cột: Tình trạng hôn nhân (marital.status)",
    x = "Tình trạng hôn nhân",
    y = "Tần số"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    axis.text.x = element_text(angle = 45, hjust = 1),
    
  )

ggplot(ts_marital_df, aes(x = reorder(Gia_tri, Ty_le), y = Ty_le, fill = Gia_tri)) +
  geom_col(width = 0.6, color = "white") +
  geom_text(aes(label = paste0(Ty_le, "%")),
            hjust = -0.1, size = 4, fontface = "bold", color = "black") +
  coord_flip() +
  labs(
    title = "Biểu đồ cột ngang: Tỷ lệ tình trạng hôn nhân (marital.status)",
    x = "Tình trạng hôn nhân",
    y = "Tỷ lệ (%)"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold")
  )

2.1.4 Nhận xét

• “Married-civ-spouse” (kết hôn hợp pháp) chiếm 43.94%, cao nhất trong toàn bộ dữ liệu – cho thấy cấu trúc gia đình truyền thống vẫn chiếm ưu thế.

• “Never-married” đạt 32.81%, là nhóm lớn thứ hai, phản ánh sự hiện diện mạnh mẽ của người độc thân.

• Các nhóm còn lại như “Divorced” (12.29%), “Married-spouse-absent” (4.79%), “Separated” (3.13%), và “Widowed” (3.05%) góp phần tạo nên tính đa dạng trong tình trạng hôn nhân, nhưng đều chiếm tỷ lệ thấp hơn

2.2 Biến income

2.2.1 Giải thích biến

# Giải thích các mức của biến income
income_levels <- data.frame(
  Gia_tri = c("<=50K", ">50K"),
  Y_nghia = c("Thu nhập dưới hoặc bằng 50.000 USD/năm", "Thu nhập trên 50.000 USD/năm")
)

knitr::kable(income_levels, caption = "Giải thích các mức trong biến income")

Giải thích các mức trong biến income

Gia_tri	Y_nghia
<=50K	Thu nhập dưới hoặc bằng 50.000 USD/năm
>50K	Thu nhập trên 50.000 USD/năm

2.2.2 Thống kê Tần suất

# Tạo bảng tần suất cho income
ts_income <- table(d$income)

# Tạo bảng dữ liệu
ts_income_df <- data.frame(
  Gia_tri = names(ts_income),
  Y_nghia = c("≤50K", ">50K"),
  Tan_so = as.vector(ts_income),
  Ty_le = round((as.vector(ts_income) / sum(ts_income)) * 100, 2)
)

# Hiển thị kết quả
ts_income_df

##   Gia_tri Y_nghia Tan_so Ty_le
## 1   <=50K    ≤50K  24720 75.92
## 2    >50K    >50K   7841 24.08

• Biến income (thu nhập) có 2 mức:

  • Thu nhập dưới hoặc bằng 50K (<=50K): 24720 người (chiếm 75.92%).

• Thu nhập trên 50K (>50K): 7841 người (chiếm 24.08%).

2.2.3 Trực quan hóa

ggplot(ts_income_df, aes(x = Gia_tri, y = Tan_so, fill = Gia_tri)) +
  geom_col(width = 0.5, color = "white") +
  geom_text(aes(label = Tan_so), vjust = -0.3, size = 4, fontface = "bold") +
  labs(
    title = "Biểu đồ cột: Thu nhập (income)",
    x = "Nhóm thu nhập",
    y = "Tần số"
  ) +
  scale_fill_manual(values = c("#6D597A", "#FFB703")) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    
  )

income_colors <- c("<=50K" = "#FDB863", ">50K" = "#5E3C99")

ggplot(ts_income_df, aes(x = "", y = Ty_le, fill = Gia_tri)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  scale_fill_manual(values = income_colors) +
  labs(title = "Biểu đồ tròn: Thu nhập") +
  geom_text(aes(label = paste0(Ty_le, "%")),
            position = position_stack(vjust = 0.5),
            size = 5, color = "black") +
  theme_void() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    legend.title = element_blank()
  )

2.2.4 Nhận xét

• Nhóm có thu nhập <=50K chiếm 75.92%, cho thấy phần lớn người trong mẫu khảo sát có thu nhập thấp hơn ngưỡng trung bình.

• Chỉ 24.08% thuộc nhóm thu nhập >50K, phản ánh mức thu nhập cao là thiểu số trong cộng đồng được khảo sát.

3 Ước lượng Khoảng và Kiểm định Giả thuyết cho Tỷ lệ

3.1 Xác định Hạng mục Quan tâm

• Hạng mục “Never-married” của biến MaritalStatus – Tình trạng hôn nhân

3.2 Ước lượng Khoảng Tin cậy và Kiểm định Giả thuyết

3.2.1 Hạng mục “Never-married” của biến Tình trạng hôn nhân (marital.status)

# Số người chưa từng kết hôn
n_never_married <- sum(d$marital.status == "Never-married")

# Tổng số quan sát
n_total <- nrow(d)

# Ước lượng khoảng tin cậy 95% cho tỷ lệ người chưa từng kết hôn
prop.test(n_never_married, n_total, conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  n_never_married out of n_total, null probability 0.5
## X-squared = 3848.3, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.3229973 0.3332271
## sample estimates:
##         p 
## 0.3280919

Phân tích kết quả

• Phép kiểm định được sử dụng là kiểm định tỷ lệ 1 mẫu (1-sample proportions test) với chỉnh liên tục, nhằm cải thiện độ chính xác khi sử dụng phân phối xấp xỉ.

• Dữ liệu đầu vào: đang kiểm định tỷ lệ người có tình trạng “Never-married” (n_never_married) trong tổng số quan sát (n_total), với giả thuyết gốc H₀: p = 0.5.

• Giá trị thống kê kiểm định là X-squared = 3848.3 với df = 1, cho thấy mức độ chênh lệch lớn giữa tỷ lệ quan sát và tỷ lệ giả định.

• Giá trị p-value < 2.2e-16, cực kỳ nhỏ, đồng nghĩa với việc kết quả là rất có ý nghĩa thống kê – xác suất xảy ra sai lầm khi bác bỏ H₀ gần như bằng 0.

• Giả thuyết đối (H₁): Tỷ lệ thực sự khác 0.5 (kiểm định hai phía: khác lớn hơn hoặc nhỏ hơn đều được xem xét).

• Khoảng tin cậy 95% cho tỷ lệ người chưa kết hôn nằm trong khoảng [32.30%; 33.32%], thể hiện tỷ lệ thực sự khá ổn định quanh mức 33%.

• Tỷ lệ mẫu ước lượng là 32.81%, tức là gần 1/3 dân số trong mẫu khảo sát chưa từng kết hôn.

Bài toán kiểm định:

Giả thuyết kiểm định:

Giả thuyết không H₀: p = 0.5 (tỷ lệ người chưa từng kết hôn bằng 50%)

Giả thuyết đối H₁: p ≠ 0.5 (tỷ lệ người chưa từng kết hôn khác 50%)

Mức ý nghĩa: α = 0.05

Kết luận:

Với p-value < 2.2e-16 < 0.05, ta bác bỏ giả thuyết H₀.

Có bằng chứng thống kê mạnh cho thấy tỷ lệ người chưa từng kết hôn khác 50%, với độ tin cậy 95%.

Tỷ lệ ước lượng là 32.81%, với khoảng tin cậy nằm trong [32.30%; 33.32%]. Tỷ lệ này thấp hơn đáng kể so với mức 50%, và sự chênh lệch (~17 điểm phần trăm) là có ý nghĩa thống kê rõ rệt.

4 Phân tích Mối quan hệ giữa Hai biến Định tính (Bivariate Analysis)

Chọn cặp biến định tính :

4.1 Marital.status – Income

4.1.1 Bảng tần số chéo

# Bảng tần số chéo và tỷ lệ theo hàng giữa tình trạng hôn nhân và thu nhập
table_marital_income <- table(d$marital.status, d$income)              # Bảng tần số chéo
table_marital_income                                                   # Hiển thị bảng

##                        
##                         <=50K  >50K
##   Divorced               3980   463
##   Married-AF-spouse        13    10
##   Married-civ-spouse     8284  6692
##   Married-spouse-absent   384    34
##   Never-married         10192   491
##   Separated               959    66
##   Widowed                 908    85

prop.table(table_marital_income, margin = 1)                           # Tính tỷ lệ theo từng tình trạng hôn nhân

##                        
##                              <=50K       >50K
##   Divorced              0.89579113 0.10420887
##   Married-AF-spouse     0.56521739 0.43478261
##   Married-civ-spouse    0.55315171 0.44684829
##   Married-spouse-absent 0.91866029 0.08133971
##   Never-married         0.95403913 0.04596087
##   Separated             0.93560976 0.06439024
##   Widowed               0.91440081 0.08559919

• Trong nhóm Married-civ-spouse: có 8,284 người thu nhập <=50K và 6,692 người thu nhập >50K → tỷ lệ >50K là 44.7%.

• Trong nhóm Never-married: có 10,192 người thu nhập <=50K và 491 người thu nhập >50K → tỷ lệ >50K là 4.6%.

• Trong nhóm Divorced: có 3,980 người thu nhập <=50K và 463 người thu nhập >50K → tỷ lệ >50K là 10.4%.

• Trong nhóm Married-spouse-absent: có 384 người thu nhập <=50K và 34 người thu nhập >50K → tỷ lệ >50K là 8.1%.

• Trong nhóm Widowed: có 908 người thu nhập <=50K và 85 người thu nhập >50K → tỷ lệ >50K là 8.6%.

• Trong nhóm Separated: có 959 người thu nhập <=50K và 66 người thu nhập >50K → tỷ lệ >50K là 6.4%.

• Trong nhóm Married-AF-spouse: có 13 người thu nhập <=50K và 10 người thu nhập >50K → tỷ lệ >50K là 43.5% (nhưng mẫu nhỏ).

Kết luận: → Nhóm Married-civ-spouse có tỷ lệ thu nhập >50K cao nhất trong các nhóm đông dân số, trong khi nhóm Never-married có tỷ lệ thấp nhất. → Điều này phản ánh sự chênh lệch đáng kể về thu nhập theo tình trạng hôn nhân, đặc biệt là lợi thế của người đã kết hôn hợp pháp.

4.1.2 Trực quan hóa

# Tạo bảng dữ liệu từ bảng tần suất chéo
table_marital_income <- table(d$marital.status, d$income)
df_group_marital <- as.data.frame(as.table(table_marital_income))
colnames(df_group_marital) <- c("MaritalStatus", "Income", "Freq")

# Vẽ biểu đồ cột nhóm
ggplot(df_group_marital, aes(x = MaritalStatus, y = Freq, fill = Income)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.6) +
  geom_text(aes(label = Freq),
            position = position_dodge(width = 0.8),
            vjust = -0.4, size = 4, color = "black", fontface = "bold") +
  scale_fill_manual(
    values = c("<=50K" = "#FFA07A", ">50K" = "#20B2AA"),
    name = "Thu nhập"
  ) +
  labs(title = "Biểu đồ cột nhóm: MaritalStatus vs Income",
       x = "Tình trạng hôn nhân",
       y = "Tần số") +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    legend.position = "right"
  )

# Tạo bảng dữ liệu từ bảng tần suất chéo
table_marital_income <- table(d$marital.status, d$income)
df_stack_marital <- as.data.frame(as.table(table_marital_income))
colnames(df_stack_marital) <- c("MaritalStatus", "Income", "Freq")

# Vẽ biểu đồ cột chồng 
ggplot(df_stack_marital, aes(x = MaritalStatus, y = Freq, fill = Income)) +
  geom_bar(stat = "identity", width = 0.6) +
  geom_text(
    aes(label = Freq),
    position = position_stack(vjust = 0.5),
    vjust = 0.5, size = 4, color = "black", fontface = "bold"
  ) +
  scale_fill_manual(
    values = c("<=50K" = "#FFA07A", ">50K" = "#20B2AA"),
    name = "Thu nhập"
  ) +
  labs(
    title = "Biểu đồ cột chồng: MaritalStatus vs Income",
    x = "Tình trạng hôn nhân",
    y = "Tần số"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    legend.position = "right"
  )

4.1.3 Nhận xét mô tả

• Biểu đồ cột nhóm cho thấy những người đã kết hôn hợp pháp (Married-civ-spouse) có số lượng vượt trội ở nhóm thu nhập >50K – thanh cột ở nhóm này cao rõ rệt.

• Ngược lại, nhóm Never-married gần như chỉ xuất hiện ở mức thu nhập thấp. Các nhóm “Divorced” hay “Separated” cũng có tỷ lệ thu nhập cao rất thấp.

• Biểu đồ cột chồng cho thấy cột của nhóm Married-civ-spouse có phần màu thu nhập cao chiếm gần một nửa, trong khi các nhóm khác phần màu này rất mỏng.

→ Kết luận trực quan: Tình trạng hôn nhân có liên quan chặt chẽ đến thu nhập. Biểu đồ phản ánh rõ rằng người đã kết hôn có lợi thế lớn về kinh tế so với các nhóm còn lại.

4.1.4 Kiểm định thống kê(Kiểm định Chi-bình phương)

Giả thuyết kiểm định:

H₀ (Giả thuyết không):Tình trạng hôn nhân và mức thu nhập độc lập với nha.

H₁ (Giả thuyết đối):Tình trạng hôn nhân và mức thu nhập có mối liên hệ với nhau.

chisq.test(table_marital_income)

## 
##  Pearson's Chi-squared test
## 
## data:  table_marital_income
## X-squared = 6517.7, df = 6, p-value < 2.2e-16

Kết quả kiểm định:

Chi-squared = 6517.74

Bậc tự do (df) = 6

Giá trị p-value = 0.0000

Kết luận thống kê:

Vì p < 0.05, ta bác bỏ giả thuyết H₀.

Có mối liên hệ thống kê rõ rệt giữa tình trạng hôn nhân và mức thu nhập

Thảo luận thêm về bản chất mối quan hệ:

Biểu đồ cho thấy nhóm đã kết hôn (Married-civ-spouse) có phần thu nhập >50K chiếm ưu thế tuyệt đối.

Ngược lại, nhóm độc thân (Never-married) hầu như chỉ tập trung ở mức thu nhập thấp.

Các nhóm ly hôn, ly thân, hoặc góa cũng có tỷ lệ thu nhập cao thấp đáng kể.

→ Giải thích mối liên hệ: Kiểm định cho thấy tình trạng hôn nhân không chỉ liên quan đến thu nhập, mà còn có xu hướng rõ ràng – người đã lập gia đình có nhiều khả năng đạt thu nhập cao hơn. Điều này có thể phản ánh mức độ ổn định tài chính, độ tuổi, hoặc cam kết nghề nghiệp cao hơn trong nhóm đã kết hôn.

4.1.5 Hiệu tỷ lệ

# Lập bảng tần số chéo giữa marital.status và income
table_marital_income <- table(d$marital.status, d$income)

# Thêm tổng hàng và tổng cột
table_marital_income1 <- addmargins(table_marital_income)

# Hiển thị bảng
table_marital_income1

##                        
##                         <=50K  >50K   Sum
##   Divorced               3980   463  4443
##   Married-AF-spouse        13    10    23
##   Married-civ-spouse     8284  6692 14976
##   Married-spouse-absent   384    34   418
##   Never-married         10192   491 10683
##   Separated               959    66  1025
##   Widowed                 908    85   993
##   Sum                   24720  7841 32561

• \(p_1 = P(\text{income} = \text{">50K"} \mid \text{marital.status} = \text{"Never-married"})\) (Tỷ lệ người chưa từng kết hôn có thu nhập cao)

• \(p_2 = P(\text{income} = \text{">50K"} \mid \text{marital.status} = \text{"Married-civ-spouse"})\) (Tỷ lệ người đang kết hôn hợp pháp có thu nhập cao)

Giả thuyết kiểm định:

• \(H_0: p_1 - p_2 = 0\) (Không có sự khác biệt về tỷ lệ thu nhập cao giữa hai nhóm tình trạng hôn nhân)

• \(H_1: p_1 - p_2 < 0\) (Tỷ lệ thu nhập cao ở nhóm “Never-married” thấp hơn nhóm “Married-civ-spouse”)

# Lập bảng tần số chéo giữa marital.status và income
table_marital_income <- table(d$marital.status, d$income)

# Số người có thu nhập >50K trong từng nhóm
counts_income_high <- c(table_marital_income["Never-married", ">50K"],
                        table_marital_income["Married-civ-spouse", ">50K"])

# Tổng số người trong từng nhóm
totals_income <- c(sum(table_marital_income["Never-married", ]),
                   sum(table_marital_income["Married-civ-spouse", ]))

# Kiểm định tỉ lệ một phía: p1 < p2
test_marital_income <- prop.test(counts_income_high, totals_income,
                                 alternative = "less", correct = FALSE)

# Hiển thị kết quả
test_marital_income

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  counts_income_high out of totals_income
## X-squared = 4971.2, df = 1, p-value < 2.2e-16
## alternative hypothesis: less
## 95 percent confidence interval:
##  -1.0000000 -0.3934202
## sample estimates:
##     prop 1     prop 2 
## 0.04596087 0.44684829

Kết quả kiểm định cho thấy:

• Tỷ lệ người chưa từng kết hôn có thu nhập >50K (prop 1) là khoảng 4.60%.

• Tỷ lệ người đang kết hôn hợp pháp có thu nhập >50K (prop 2) là khoảng 44.65%.

Với p-value < 2.2e-16, nhỏ hơn mức ý nghĩa 0.05, chúng ta có đủ bằng chứng để bác bỏ giả thuyết H0. Điều này có nghĩa là:

–> Tỷ lệ người chưa từng kết hôn có thu nhập cao thấp hơn tỷ lệ người đang kết hôn hợp pháp một cách có ý nghĩa thống kê.

4.1.6 Relative Risk

Liệu tình trạng hôn nhân (đã kết hôn vs chưa bao giờ kết hôn) có ảnh hưởng đến nguy cơ có thu nhập cao không (>50K)?

→ Mục tiêu: So sánh nguy cơ có thu nhập cao ở người đã kết hôn với người chưa từng kết hôn.

install.packages("epitools", repos = "https://cloud.r-project.org")

## 
## The downloaded binary packages are in
##  /var/folders/8b/td0_s_sx51g4kyv_jqzgr1n80000gn/T//RtmpPbtfM7/downloaded_packages

library(epitools)

## Warning: package 'epitools' was built under R version 4.3.3

riskratio(table_marital_income)

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

## $data
##                        
##                         <=50K >50K Total
##   Divorced               3980  463  4443
##   Married-AF-spouse        13   10    23
##   Married-civ-spouse     8284 6692 14976
##   Married-spouse-absent   384   34   418
##   Never-married         10192  491 10683
##   Separated               959   66  1025
##   Widowed                 908   85   993
##   Total                 24720 7841 32561
## 
## $measure
##                        risk ratio with 95% C.I.
##                          estimate     lower     upper
##   Divorced              1.0000000        NA        NA
##   Married-AF-spouse     4.1722227 2.5975617 6.7014550
##   Married-civ-spouse    4.2880064 3.9266589 4.6826065
##   Married-spouse-absent 0.7805450 0.5591884 1.0895265
##   Never-married         0.4410457 0.3903710 0.4982986
##   Separated             0.6178960 0.4818083 0.7924220
##   Widowed               0.8214195 0.6586704 1.0243819
## 
## $p.value
##                        two-sided
##                           midp.exact fisher.exact   chi.square
##   Divorced                        NA           NA           NA
##   Married-AF-spouse     5.857500e-05 5.164112e-05 2.767102e-07
##   Married-civ-spouse    0.000000e+00 0.000000e+00 0.000000e+00
##   Married-spouse-absent 1.350522e-01 1.512784e-01 1.400969e-01
##   Never-married         0.000000e+00 7.032552e-38 4.455345e-41
##   Separated             5.197404e-05 6.379070e-05 1.013461e-04
##   Widowed               7.502949e-02 8.040431e-02 7.825486e-02
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Nhận xét kết quả

Kết quả

• Trong số 14,976 người đã kết hôn, có 6,692 người (44.69%) có thu nhập >50K.

• Trong số 10,683 người chưa bao giờ kết hôn, chỉ có 491 người (4.60%) có thu nhập >50K.

• Tỷ số nguy cơ (RR) = 9.72 → Người đã kết hôn có xác suất có thu nhập >50K cao hơn gần 10 lần so với người chưa từng kết hôn.

• Khoảng tin cậy 95% = [8.90, 10.62] → Không bao gồm 1 → khác biệt có ý nghĩa thống kê mạnh mẽ.

• p-value = 0.000 ở tất cả các kiểm định → xác nhận kết quả là cực kỳ có ý nghĩa thống kê.

Kết luận

• Dựa trên kết quả phân tích, người đã kết hôn có nguy cơ có thu nhập cao vượt trội so với người chưa từng kết hôn. Tỷ số nguy cơ là 9.72, khoảng tin cậy 95% là [8.90, 10.62], và p-value bằng 0 cho thấy mối liên hệ rất mạnh mẽ và có ý nghĩa thống kê. Tình trạng hôn nhân là một yếu tố quan trọng ảnh hưởng đến khả năng đạt mức thu nhập cao trong bộ dữ liệu này.

4.1.7 Odds Ratio - OR

# Ước lượng odds ratio từng nhóm so với nhóm "Divorced"
or_result <- oddsratio(table_marital_income)

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

# In kết quả
print(or_result)

## $data
##                        
##                         <=50K >50K Total
##   Divorced               3980  463  4443
##   Married-AF-spouse        13   10    23
##   Married-civ-spouse     8284 6692 14976
##   Married-spouse-absent   384   34   418
##   Never-married         10192  491 10683
##   Separated               959   66  1025
##   Widowed                 908   85   993
##   Total                 24720 7841 32561
## 
## $measure
##                        odds ratio with 95% C.I.
##                          estimate     lower      upper
##   Divorced              1.0000000        NA         NA
##   Married-AF-spouse     6.6313682 2.7883118 15.2865405
##   Married-civ-spouse    6.9415692 6.2783544  7.6929581
##   Married-spouse-absent 0.7643062 0.5219850  1.0836587
##   Never-married         0.4141385 0.3628557  0.4727149
##   Separated             0.5928455 0.4499804  0.7690263
##   Widowed               0.8058970 0.6287078  1.0215482
## 
## $p.value
##                        two-sided
##                           midp.exact fisher.exact   chi.square
##   Divorced                        NA           NA           NA
##   Married-AF-spouse     5.857500e-05 5.164112e-05 2.767102e-07
##   Married-civ-spouse    0.000000e+00 0.000000e+00 0.000000e+00
##   Married-spouse-absent 1.350522e-01 1.512784e-01 1.400969e-01
##   Never-married         0.000000e+00 7.032552e-38 4.455345e-41
##   Separated             5.197404e-05 6.379070e-05 1.013461e-04
##   Widowed               7.502949e-02 8.040431e-02 7.825486e-02
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Ước lượng Odds Ratio (OR) cho các nhóm tình trạng hôn nhân, tham chiếu là “Divorced” - Nhóm Married-civ-spouse có OR = 6.94 (95% CI: 6.28 – 7.69), p-value = 0.0000. –> Người đang kết hôn hợp pháp có khả năng có thu nhập >50K cao hơn gần 7 lần so với người đã ly hôn. Sự khác biệt này có ý nghĩa thống kê rất cao.

• Nhóm Never-married có OR = 0.41 (95% CI: 0.36 – 0.47), p-value = 0.0000. –> Những người chưa từng kết hôn có khả năng đạt thu nhập cao chỉ bằng 41% so với nhóm ly hôn. Đây là sự khác biệt có ý nghĩa thống kê rõ rệt.

• Nhóm Separated có OR = 0.59 (95% CI: 0.45 – 0.77), p-value = 0.0001. –> Những người ly thân có xác suất thu nhập cao thấp hơn đáng kể so với người ly hôn, và sự khác biệt này có ý nghĩa thống kê.

• Nhóm Widowed có OR = 0.81 (95% CI: 0.63 – 1.02), p-value = 0.0750. –> Mặc dù có xu hướng thu nhập thấp hơn nhóm ly hôn, nhưng vì khoảng tin cậy bao gồm 1 và p-value > 0.05 nên chưa đủ bằng chứng thống kê để kết luận.

• Nhóm Married-AF-spouse có OR = 6.63 (95% CI: 2.79 – 15.29), p-value ≈ 0.00006. –> Mặc dù nhóm này rất nhỏ (n = 23), kết quả cho thấy khả năng có thu nhập cao cũng cao hơn nhiều so với người ly hôn và có ý nghĩa thống kê.

• Nhóm Married-spouse-absent có OR = 0.76 (95% CI: 0.52 – 1.08), p-value ≈ 0.135. –> Không có đủ bằng chứng thống kê để kết luận có sự khác biệt về thu nhập so với nhóm ly hôn.

Tóm lại:

Kết quả phân tích cho thấy tình trạng hôn nhân có mối liên hệ đáng kể với mức thu nhập. Nhóm đang sống trong hôn nhân hợp pháp (Married-civ-spouse) có xác suất đạt thu nhập cao vượt trội so với các nhóm khác, đặc biệt là người ly hôn, chưa kết hôn hay ly thân. Những khác biệt này có ý nghĩa thống kê rõ ràng, ngoại trừ một số nhóm có quy mô mẫu nhỏ hoặc khoảng tin cậy chứa 1.