Mục tiêu
Bộ dữ liệu được sử dụng trong phân tích này phản ánh đặc điểm nhân khẩu học và tình trạng việc làm của lực lượng lao động Hoa Kỳ năm 2023. Dữ liệu được thu thập từ các nguồn điều tra dân số, bao gồm nhiều biến liên quan đến giới tính, trình độ học vấn, ngành nghề, tình trạng hôn nhân, thu nhập,… Mục tiêu của chương này là giới thiệu, kiểm tra và làm sạch dữ liệu thông qua tối thiểu 10 thao tác cơ bản, nhằm đảm bảo độ tin cậy trước khi tiến hành phân tích chuyên sâu ở các chương sau.
# 1. Đọc dữ liệu từ file Excel
df_raw <- read_excel("data_2023_hoaKy.xlsx")
# 2. Chuẩn hóa tên cột để thuận tiện thao tác
df <- df_raw %>%
clean_names()
# 3. Xem 6 dòng đầu tiên sau khi làm sạch
df %>%
head() %>%
knitr::kable(caption = "6 dòng dữ liệu đầu tiên sau khi làm sạch tên cột")
| age | sex | race | marst | empstat | occ | ind | educ | fullpart | incwage |
|---|---|---|---|---|---|---|---|---|---|
| 66 | Female | White | Separated | Not in labor force | Not in universe | N/A (not applicable) | Some college | Not working | 0 |
| 68 | Female | White | Separated | Not in labor force | Not in universe | N/A (not applicable) | Some college | Not working | 0 |
| 52 | Female | White | Married, spouse present | Not in labor force | Not in universe | N/A (not applicable) | Some college | Not working | 0 |
| 51 | Male | White | Married, spouse present | Employed | Retail salespersons | Auto parts, accessories, and tire stores | Some college | Full-time | 42000 |
| 78 | Female | White | Separated | Not in labor force | Not in universe | N/A (not applicable) | Some college | Not working | 0 |
| 65 | Male | White | Married, spouse present | Not in labor force | Janitors and building cleaners | Colleges and universities, including junior colleges | Some college | Full-time | 55000 |
Giải thích kỹ thuật
read_excel(): Hàm từ gói readxl dùng để đọc file Excel. Tham số bắt buộc là đường dẫn file, các tham số không bắt buộc gồm sheet (chỉ định sheet), range (phạm vi ô), col_types (kiểu dữ liệu cột).
clean_names(): Hàm từ gói janitor tự động chuẩn hóa tên cột: chuyển chữ thường, thay khoảng trắng bằng dấu gạch dưới, loại bỏ ký tự đặc biệt.
head() %>% knitr::kable(): head() lấy 6 dòng đầu, kable() định dạng thành bảng đẹp trong RMarkdown.
Ý nghĩa thống kê
Đọc dữ liệu đúng và chuẩn hoá tên cột là bước đầu tiên thiết yếu — đảm bảo các hàm tiếp theo tham chiếu chính xác tên biến.
Việc kiểm tra 6 dòng đầu giúp phát hiện sớm: header bị lệch (ví dụ file có metadata ở hàng trên), cột bị ghép, hoặc sai kiểu dữ liệu (số đọc thành chuỗi).
# 4. Danh sách biến định tính cần chuyển
factor_vars <- c("sex", "race", "marst", "empst", "occ", "ind", "educ", "fullpart","empstat")
# 5. Giữ lại các biến thực sự tồn tại trong dataset
factor_vars <- factor_vars[factor_vars %in% names(df)]
# 6. Chuyển các biến ký tự sang factor
df <- df %>%
mutate(across(where(is.character), as.factor))
# 7. Kiểm tra lại cấu trúc dữ liệu
glimpse(df)
Rows: 146,133
Columns: 10
$ age <dbl> 66, 68, 52, 51, 78, 65, 68, 74, 74, 76, 75, 63, 64, 41, 1, 52…
$ sex <fct> Female, Female, Female, Male, Female, Male, Female, Female, M…
$ race <fct> White, White, White, White, White, White, White, White, White…
$ marst <fct> "Separated", "Separated", "Married, spouse present", "Married…
$ empstat <fct> Not in labor force, Not in labor force, Not in labor force, E…
$ occ <fct> "Not in universe", "Not in universe", "Not in universe", "Ret…
$ ind <fct> "N/A (not applicable)", "N/A (not applicable)", "N/A (not app…
$ educ <fct> Some college, Some college, Some college, Some college, Some …
$ fullpart <fct> Not working, Not working, Not working, Full-time, Not working…
$ incwage <dbl> 0, 0, 0, 42000, 0, 55000, 52000, 0, 0, 0, 0, 22000, 45000, 0,…
Giải thích kỹ thuật
factor_vars %in% names(df): Toán tử %in% kiểm tra phần tử nào trong vector tồn tại trong tên cột của dataframe.
mutate(across(where(is.character), as.factor)): across() áp dụng hàm as.factor() cho tất cả cột kiểu character.
where(is.character) là điều kiện lọc.
glimpse(): Hiển thị tổng quan cấu trúc dữ liệu (kiểu dữ liệu, số quan sát, giá trị mẫu).
Ý nghĩa thống kê
Biến phân loại (categorical) nên được mã hóa dưới dạng factor để R biết xử lý đúng khi gom nhóm (group_by, table, lm với dummy), khi vẽ biểu đồ (ggplot tự nhận levels), và để đảm bảo các phép hồi quy tạo đúng biến giả (dummy) theo thứ tự levels mong muốn.
Lưu ý: Thứ tự levels mặc định là theo thứ tự chữ (alphabetical) — nếu bạn muốn một thứ tự logic (ví dụ: Low, Medium, High) cần dùng factor(…, levels = c(…)).
# 8. Cấu trúc dữ liệu
str(df)
tibble [146,133 × 10] (S3: tbl_df/tbl/data.frame)
$ age : num [1:146133] 66 68 52 51 78 65 68 74 74 76 ...
$ sex : Factor w/ 2 levels "Female","Male": 1 1 1 2 1 2 1 1 2 2 ...
$ race : Factor w/ 6 levels "American Indian",..: 6 6 6 6 6 6 6 6 6 6 ...
$ marst : Factor w/ 6 levels "Divorced","Married, spouse absent",..: 4 4 3 3 4 3 3 3 3 3 ...
$ empstat : Factor w/ 4 levels "Employed","NIU",..: 3 3 3 1 3 3 3 3 3 3 ...
$ occ : Factor w/ 527 levels "Accountants and auditors",..: 319 319 319 438 319 251 368 319 319 319 ...
$ ind : Factor w/ 264 levels "Accounting, tax preparation, bookkeeping and payroll services",..: 149 149 149 20 149 45 120 149 149 149 ...
$ educ : Factor w/ 5 levels "Associate degree",..: 4 4 4 4 4 4 1 5 5 3 ...
$ fullpart: Factor w/ 3 levels "Full-time","Not working",..: 2 2 2 1 2 1 1 2 3 2 ...
$ incwage : num [1:146133] 0 0 0 42000 0 55000 52000 0 0 0 ...
# 9. Kích thước bộ dữ liệu
cat(paste("Bộ dữ liệu có", nrow(df), "quan sát và", ncol(df), "biến.\n"))
Bộ dữ liệu có 146133 quan sát và 10 biến.
Giải thích kỹ thuật
str(object) hiển thị cấu trúc: kiểu data.frame/tibble, số quan sát, số biến; cho từng biến: tên, kiểu (int, num, factor, chr), vài giá trị đầu. Rất hữu ích để phát hiện cột chưa đổi kiểu.
nrow(), ncol() trả về số dòng/số cột. paste() nối chuỗi; cat() in ra console mà không có dấu ngoặc.
Ý nghĩa thống kê
Biết kích thước dataset giúp ước lượng sức mạnh mẫu (sample size), quyết định chọn phương pháp: với >100k obs, nhiều phương pháp phi tham số vẫn ổn, CI sẽ nhỏ hơn.
str() phát hiện lỗi kiểu dữ liệu (ví dụ: cột age lưu dạng chr do có ký tự “n/a” nên cần chuyển sang numeric hoặc xử lý).
names(df)
[1] "age" "sex" "race" "marst" "empstat" "occ"
[7] "ind" "educ" "fullpart" "incwage"
head(df)
Giải thích kỹ thuật
names(): Trả về vector chứa tên tất cả các cột.
head(): Mặc định hiển thị 6 dòng đầu, có thể thay đổi bằng tham số n.
Ý nghĩa thống kê
Kiểm tra trực quan dữ liệu mẫu giúp phát hiện outliers dạng text (ví dụ “Unknown”, “N/A”, “Prefer not to say”) mà readxl có thể không gán NA. Nếu xuất hiện, cần chuyển những chuỗi đại diện này thành NA hoặc levels hợp lệ trước phân tích.
# 10. Kiểm tra NA
na_by_column <- colSums(is.na(df))
columns_with_na <- na_by_column[na_by_column > 0]
if(length(columns_with_na) > 0) {
cat("Các cột có giá trị bị thiếu:\n")
data.frame(
Column = names(columns_with_na),
NA_Count = columns_with_na
) %>%
kable(caption = "Số lượng giá trị NA theo cột") %>%
kable_styling()
} else {
cat("\nBộ dữ liệu không có giá trị bị thiếu nào.")
}
Bộ dữ liệu không có giá trị bị thiếu nào.
Giải thích kỹ thuật
is.na(df) trả một ma trận logical cùng kích thước với df.
colSums() cộng TRUE (TRUE được coi là 1) theo cột → số NA từng cột.
if(length(columns_with_na) > 0) kiểm tra có cột nào có NA hay không; data.frame() để in bảng dễ đọc.
kable_styling() (gói kableExtra) trang trí bảng.
Ý nghĩa thống kê
Dataset không có NA cho thấy chất lượng dữ liệu tốt, không cần xử lý khuyết thiếu, đảm bảo độ tin cậy cho các phân tích tiếp theo.
# 11. Đếm số dòng trùng hoàn toàn
num_duplicated_rows <- sum(duplicated(df))
cat(paste("Tổng số dòng bị trùng lặp hoàn toàn là:", num_duplicated_rows, "\n"))
Tổng số dòng bị trùng lặp hoàn toàn là: 65820
# 12. Thống kê tần suất xuất hiện của từng dòng
duplicated_summary <- df %>%
group_by(across(everything())) %>%
summarise(Frequency = n(), .groups = "drop") %>%
arrange(desc(Frequency))
# Hiển thị 10 dòng ngẫu nhiên
duplicated_summary %>%
sample_n(10) %>%
knitr::kable(caption ="10 dòng ngẫu nhiên trong bảng tần suất trùng lặp toàn bộ biến")
| age | sex | race | marst | empstat | occ | ind | educ | fullpart | incwage | Frequency |
|---|---|---|---|---|---|---|---|---|---|---|
| 58 | Male | White | Married, spouse present | Employed | Insurance sales agents | Agencies, brokerages, and other insurance related activities | Graduate degree | Full-time | 180000 | 1 |
| 52 | Female | White | Married, spouse present | Employed | Other psychologists | General medical and surgical hospitals, and specialty (except psychiatric and substance abuse) hospitals | Graduate degree | Part-time | 100000 | 1 |
| 44 | Female | White | Married, spouse present | Employed | Janitors and building cleaners | Services to buildings and dwellings (except cleaning during construction and immediately after construction) | Some high school | Full-time | 48000 | 1 |
| 45 | Female | Asian | Married, spouse present | Employed | Educational, guidance, and career counselors and advisors | Colleges and universities, including junior colleges | Some college | Part-time | 40000 | 1 |
| 48 | Female | White | Married, spouse present | Employed | First-Line supervisors of retail sales workers | Supermarkets and other grocery (except convenience) stores | Some college | Full-time | 30000 | 1 |
| 41 | Male | White | Single | Employed | Postsecondary teachers | Colleges and universities, including junior colleges | Graduate degree | Full-time | 98400 | 1 |
| 21 | Male | Black | Single | Employed | Inspectors, testers, sorters, samplers, and weighers | Motor vehicles and motor vehicle equipment manufacturing | Some college | Full-time | 12000 | 1 |
| 39 | Male | White | Single | Employed | Education and childcare administrators | Colleges and universities, including junior colleges | Some college | Full-time | 36000 | 1 |
| 41 | Male | Black | Married, spouse present | Employed | Lawyers | Banking and related activities | Graduate degree | Full-time | 230000 | 1 |
| 63 | Male | White | Married, spouse present | Employed | First-Line supervisors of retail sales workers | Automobile dealers | Some college | Full-time | 70000 | 1 |
# 13. Tần suất trùng lặp cao nhất và thấp nhất
max_freq <- max(duplicated_summary$Frequency)
min_freq <- min(duplicated_summary$Frequency)
cat(paste("Tần suất trùng lặp cao nhất là:", max_freq, "\n"))
Tần suất trùng lặp cao nhất là: 906
cat(paste("Tần suất trùng lặp thấp nhất là:", min_freq, "\n"))
Tần suất trùng lặp thấp nhất là: 1
Giải thích kỹ thuật
duplicated(df) trả logical vector TRUE cho dòng nào là bản sao của một dòng trước đó; sum() đếm số TRUE.
group_by(across(everything())) nhóm theo tất cả cột — mỗi nhóm tương ứng một tổ hợp đặc điểm duy nhất; summarise(Frequency = n()) đếm số lần xuất hiện. .groups = “drop” để tránh giữ grouping.
arrange(desc(Frequency)) sắp xếp giảm dần theo tần suất.
sample_n(10) lấy mẫu 10 dòng để xem nhanh.
Ý nghĩa thống kê
Có 65,820 dòng trùng (≈45%) — đây là tỷ lệ đáng lưu ý. Nguyên nhân chủ yếu:
Tính chất của dữ liệu điều tra: Trong khảo sát lao động quy mô lớn, việc nhiều cá nhân có cùng đặc điểm nhân khẩu học, trình độ học vấn và nghề nghiệp là hoàn toàn tự nhiên.
Cấu trúc thực tế của thị trường lao động: Một số ngành nghề phổ biến tập trung số lượng lớn lao động có profile tương đồng.
Ảnh hưởng kỹ thuật:
Khuyến nghị: Trong bối cảnh dữ liệu điều tra lao động, hiện tượng trùng lặp này là hợp lý và chấp nhận được. Nên tiếp tục phân tích với dữ liệu gốc, kết hợp các phương pháp ước lượng robust khi cần suy luận thống kê.
# 14. Thống kê cơ bản
summary(df)
age sex race
Min. : 0.00 Female:74834 American Indian : 2195
1st Qu.:18.00 Male :71299 Asian : 10757
Median :38.00 Black : 17187
Mean :38.73 Multiracial : 806
3rd Qu.:58.00 Pacific Islander: 3567
Max. :85.00 White :111621
marst empstat
Divorced :11085 Employed :69160
Married, spouse absent : 1642 NIU :29483
Married, spouse present:58636 Not in labor force:45018
Separated : 6564 Unemployed : 2472
Single :66223
Widowed : 1983
occ
Not in universe :74481
Managers, all other : 2510
Elementary and middle school teachers : 1638
Driver/sales workers and truck drivers : 1619
Registered nurses : 1498
First-Line supervisors of retail sales workers: 1324
(Other) :63063
ind
N/A (not applicable) :74481
Construction : 5368
Elementary and secondary schools : 4493
Restaurants and other food services : 4264
General medical and surgical hospitals, and specialty (except psychiatric and substance abuse) hospitals: 3349
Colleges and universities, including junior colleges : 1718
(Other) :52460
educ fullpart incwage
Associate degree :11033 Full-time :59851 Min. : 0
Elementary school:29813 Not working:72947 1st Qu.: 0
Graduate degree :38150 Part-time :13335 Median : 0
Some college :51903 Mean : 31456
Some high school :15234 3rd Qu.: 45000
Max. :1549999
Giải thích kỹ thuật
summary(): Hàm generic cung cấp thống kê tóm tắt tùy theo kiểu dữ liệu:
Biến số: min, Q1, median, mean, Q3, max
Biến factor: tần số các level
Ý nghĩa thống kê
Tuổi (age): Trung bình 38.73, từ 0-85 tuổi, phân bố khá cân đối
Giới tính (sex): Tương đối cân bằng (74,834 nữ vs 71,299 nam)
Chủng tộc (race): Đa số là White (76.4%), tiếp theo là Black (11.8%)
Tình trạng hôn nhân: Đa số married (40.1%) và single (45.3%)
Tình trạng việc làm: 47.3% employed, 30.8% not in labor force
Thu nhập (incwage): Trung vị = 0, trung bình = 31,456, max = 1.55M - cho thấy phân phối lệch phải, nhiều người không có thu nhập
Dựa trên giả định nghiên cứu về mối quan hệ giữa học vấn, giới tính, tuổi tác và thu nhập, phần này thực hiện các thao tác xử lý, chuẩn hóa và mã hóa nhằm chuẩn bị dữ liệu cho các phân tích thống kê và mô hình hóa.
df <- df %>%
# Ép incwage sang numeric an toàn (tránh lỗi factor -> logical)
mutate(incwage = as.numeric(as.character(incwage))) %>%
# Loại bỏ NA và các giá trị âm hoặc quá lớn (>500000)
filter(!is.na(incwage) & incwage >= 0 & incwage < 500000)
Giải thích kỹ thuật
mutate() từ dplyr dùng để tạo hoặc sửa cột trong dataframe. Ở đây, dùng để ép incwage sang kiểu numeric thông qua as.numeric(as.character(incwage)) nhằm tránh lỗi factor sang logical.
filter() lọc các dòng theo điều kiện: loại bỏ giá trị NA, âm hoặc quá lớn (>500000).
%>% (pipe) giúp kết nối các bước, kết quả bước trước thành đầu vào của bước sau.
Ý nghĩa thống kê
Loại bỏ các giá trị bất thường giúp dữ liệu thu nhập đáng tin cậy hơn, tránh ảnh hưởng tiêu cực đến trung bình, độ lệch chuẩn hay các percentiles.
Những giá trị >500000 giả định là nhập nhầm hoặc ngoại lai. Việc này đảm bảo phân tích sau này chính xác hơn..
# Chỉ xét người thực sự có thu nhập (>0) và đang làm việc
df_income <- df %>%
filter(incwage > 0 & empstat %in% c("Employed", "Employed - at work", "Employed - absent"))
# Tính Q1, Q3 và IQR
Q1 <- quantile(df_income$incwage, 0.25, na.rm = TRUE)
Q3 <- quantile(df_income$incwage, 0.75, na.rm = TRUE)
IQR_val <- IQR(df_income$incwage, na.rm = TRUE)
# Xử lý outlier: giá trị ngoài ngưỡng IQR -> NA
df <- df %>%
mutate(
incwage = ifelse(
incwage < (Q1 - 1.5 * IQR_val) | incwage > (Q3 + 1.5 * IQR_val),
NA, incwage
)
)
# Kiểm tra kiểu dữ liệu và thống kê trên nhóm có thu nhập thực
str(df$incwage) # num
num [1:145673] 0 0 0 42000 0 55000 52000 0 0 0 ...
summary(df_income$incwage) # Thống kê Q1, Median, Mean, Q3, Max chỉ cho người có thu nhập >0
Min. 1st Qu. Median Mean 3rd Qu. Max.
2 30000 50000 64418 80000 495000
Giải thích kỹ thuật
Dữ liệu được lọc để chỉ giữ lại những người có thu nhập thực (>0) và đang làm việc (empstat thuộc nhóm Employed, Employed - at work, Employed - absent), nhằm đảm bảo việc xác định ngoại lai (outlier) không bị nhiễu bởi các quan sát thu nhập bằng 0 hoặc không thuộc lực lượng lao động.
Hai phần vị Q1(25%) và Q3(75%) được tính bằng hàm quantile(); từ đó giá trị IQR = Q3 − Q1 được tính bằng IQR().
Theo quy tắc Tukey, các giá trị nằm ngoài khoảng [Q1 - 1.5IQR, Q3 + 1.5IQR] được xem là ngoại lai.
Hàm ifelse() trong mutate() được dùng để gán NA cho các giá trị ngoài khoảng này thay vì xóa hẳn hàng, nhằm giữ nguyên cấu trúc dữ liệu và đánh dấu các quan sát không hợp lệ.
Sau bước xử lý, kiểu dữ liệu incwage được đảm bảo là numeric, thuận tiện cho các phép tính thống kê mô tả và hồi quy sau này.
Ý nghĩa thống kê
Kết quả thống kê cho nhóm người có thu nhập thực (>0) cho thấy:
Q1 = 30,000, Median = 50,000, Mean = 64,418, Q3 = 80,000, Max = 495,000.
Phần lớn người lao động có thu nhập nằm trong khoảng 30.000–80.000, tức là phân phối thu nhập khá tập trung quanh mức trung vị.
Trung bình (Mean) cao hơn trung vị (Median) cho thấy phân phối lệch phải (right-skewed) — tồn tại một số cá nhân có thu nhập rất cao kéo trung bình lên.
Việc gán NA cho outlier giúp giảm ảnh hưởng của các giá trị cực trị (ví dụ nhập sai đơn vị hoặc trường hợp thu nhập đặc biệt lớn), từ đó tăng độ tin cậy của các ước lượng thống kê và tránh sai lệch khi phân tích hồi quy.
Ngoài ra, việc xử lý này còn làm cơ sở cho các bước phân nhóm thu nhập ở phần sau, đảm bảo ranh giới giữa các nhóm được xác định dựa trên dữ liệu “sạch” và hợp lý.
Nhận xét chung Hai bước đầu giúp loại bỏ và xử lý các giá trị ngoại lai trong biến thu nhập, đảm bảo dữ liệu có độ tin cậy cao hơn trước khi phân tích.
df <- df %>%
mutate(Thu_nhập = case_when(
incwage < 25000 ~ "Thấp",
incwage >= 25000 & incwage < 50000 ~ "Trung bình thấp",
incwage >= 50000 & incwage < 100000 ~ "Trung bình cao",
incwage >= 100000 ~ "Cao",
TRUE ~ "Không xác định"
))
df$Thu_nhập <- factor(df$Thu_nhập,
levels = c("Thấp", "Trung bình thấp", "Trung bình cao", "Cao"))
df %>%
count(Thu_nhập, name = "Số lượng") %>%
knitr::kable(caption ="Tần số các nhóm thu nhập sau khi phân loại")
| Thu_nhập | Số lượng |
|---|---|
| Thấp | 92646 |
| Trung bình thấp | 19105 |
| Trung bình cao | 22165 |
| Cao | 7977 |
| NA | 3780 |
Giải thích kỹ thuật
Hàm mutate() (từ dplyr) được sử dụng để tạo biến mới Thu_nhập từ biến định lượng incwage.
Bên trong, case_when() cho phép gán nhãn theo các khoảng giá trị:
Dưới 25.000 USD là nhóm “Thấp”
Từ 25.000–50.000 USD là nhóm “Trung bình thấp”
Từ 50.000–100.000 USD là nhóm “Trung bình cao”
Trên 100.000 USD là nhóm “Cao”
Các giá trị không xác định hoặc bị gán NA ở bước xử lý outlier sẽ được giữ nguyên dưới dạng NA.
Hàm factor() giúp xác định thứ tự hiển thị hợp lý giữa các nhóm thu nhập khi biểu diễn hoặc mô hình hóa.
Ý nghĩa thống kê
Việc phân nhóm thu nhập cho phép biến định lượng incwage trở thành biến phân loại, thuận lợi cho mô tả, so sánh, hoặc mô hình hóa hồi quy dạng phân nhóm.
Kết quả cho thấy phần lớn mẫu nằm trong nhóm “Thu nhập thấp” (92.646 người), phản ánh phân bố thu nhập không đồng đều trong dân số khảo sát.
Nhóm “Trung bình cao” và “Cao” chiếm tỷ trọng nhỏ, phù hợp với đặc điểm thu nhập tập trung ở mức thấp – trung bình của lực lượng lao động.
Sự xuất hiện 3.780 giá trị NA cho thấy những quan sát này đã bị loại ở bước xử lý outlier (do thu nhập bất thường). Việc giữ NA giúp đảm bảo tính trung thực của dữ liệu và tránh làm sai lệch phân bố thu nhập chung.
df <- df %>%
mutate(empstat = str_squish(as.character(empstat)),
Tình_trạng_việc_làm = case_when(
empstat %in% c("Employed") ~ "Có việc làm",
empstat %in% c("Unemployed") ~ "Thất nghiệp",
empstat %in% c("Not in labor force", "NIU") ~ "Ngoài lực lượng lao động",
TRUE ~ "Không xác định"
))
df$Tình_trạng_việc_làm <- factor(df$Tình_trạng_việc_làm,
levels = c("Có việc làm", "Thất nghiệp",
"Ngoài lực lượng lao động", "Không xác định"))
df %>%
count(Tình_trạng_việc_làm, name = "Số lượng") %>%
knitr::kable(caption ="Tần số theo tình trạng việc làm")
| Tình_trạng_việc_làm | Số lượng |
|---|---|
| Có việc làm | 68710 |
| Thất nghiệp | 2470 |
| Ngoài lực lượng lao động | 74493 |
Giải thích kỹ thuật
mutate(empstat = str_squish(as.character(empstat))): Chuyển biến empstat từ factor sang character bằng as.character(), sau đó dùng str_squish() (từ gói stringr) để chuẩn hóa chuỗi - loại bỏ khoảng trắng thừa ở đầu/cuối và giữa các từ, đảm bảo so sánh giá trị chính xác.
case_when(…): Ánh xạ có điều kiện các giá trị gốc sang nhóm mới có ý nghĩa:
“Employed” → “Có việc làm”
“Unemployed” → “Thất nghiệp”
“Not in labor force” và “NIU” → “Ngoài lực lượng lao động”
Các trường hợp còn lại → “Không xác định”
factor(…, levels = c(…)): Chuyển biến mới thành factor với thứ tự levels được xác định trước, giúp kiểm soát thứ tự hiển thị trong biểu đồ và phân tích.
count(Tình_trạng_việc_làm, name = “Số lượng”): Đếm số quan sát theo từng nhóm tình trạng việc làm.
knitr::kable(): Định dạng kết quả thành bảng đẹp trong báo cáo.
Ý nghĩa thống kê
Phân bổ thực tế: Nhóm “Ngoài lực lượng lao động” chiếm tỷ lệ cao nhất (74,493), phản ánh đúng cấu trúc dân số bao gồm người không tham gia thị trường lao động (học sinh, người nghỉ hưu, nội trợ…). Nhóm “Có việc làm” chiếm 68,710 quan sát, trong khi “Thất nghiệp” chỉ có 2,470 - phù hợp với tỷ lệ thất nghiệp thực tế.
Ảnh hưởng phân tích: Việc gộp “NIU” vào “Ngoài lực lượng lao động” là hợp lý về mặt phương pháp luận, vì nhóm này không thuộc đối tượng khảo sát về tình trạng việc làm. Khi phân tích thu nhập, cần tách riêng từng nhóm để tránh làm sai lệch các ước lượng (ví dụ: thu nhập trung bình sẽ bị kéo xuống thấp nếu bao gồm cả người không làm việc).
Ứng dụng: Biến mới này tạo điều kiện thuận lợi cho các phân tích so sánh thu nhập, điều kiện làm việc theo tình trạng việc làm, và là biến quan trọng trong các mô hình dự báo thị trường lao động.
df <- df %>%
mutate(Trình_độ_học_vấn = case_when(
educ %in% c( "Elementary school") ~ "Thấp",
educ %in% c("Some high school", "Some college") ~ "Trung bình",
educ %in% c("Associate degree", "Graduate degree") ~ "Cao",
TRUE ~ "Không xác định"
))
df$Trình_độ_học_vấn <- factor(df$Trình_độ_học_vấn, levels = c("Thấp", "Trung bình", "Cao"))
df %>%
count(Trình_độ_học_vấn, name = "Số lượng") %>%
knitr::kable(caption ="Tần số trình độ học vấn sau khi nhóm")
| Trình_độ_học_vấn | Số lượng |
|---|---|
| Thấp | 29811 |
| Trung bình | 67039 |
| Cao | 48823 |
Giải thích kỹ thuật
case_when(…): Thực hiện ánh xạ có điều kiện để nhóm các trình độ học vấn chi tiết thành 3 nhóm lớn:
“Elementary school” → “Thấp” (Tiểu học)
“Some high school”, “Some college” → “Trung bình” (Một phần trung học/đại học)
“Associate degree”, “Graduate degree” → “Cao” (Cao đẳng, Đại học và sau đại học)
Các trường hợp khác → “Không xác định”
factor(…, levels = c(“Thấp”, “Trung bình”, “Cao”)): Chuyển biến mới thành factor với thứ tự levels được sắp xếp theo logic tăng dần về trình độ, giúp:
Kiểm soát thứ tự hiển thị trong biểu đồ và bảng biểu
Đảm bảo đúng thứ tự trong các phân tích thống kê có thứ tự
count(Trình_độ_học_vấn, name = “Số lượng”): Đếm tần suất quan sát cho từng nhóm trình độ học vấn sau khi nhóm.
Ý nghĩa thống kê
Phân bổ trình độ: Dữ liệu cho thấy phân phối trình độ học vấn khá cân bằng:
Nhóm “Trung bình” chiếm tỷ lệ cao nhất (67,039 - ≈46%), phản ánh thực tế phần lớn lực lượng lao động có trình độ phổ thông hoặc một phần đại học
Nhóm “Cao” chiếm 48,823 (≈33%), cho thấy tỷ lệ khá lớn lao động có bằng cấp từ cao đẳng trở lên
Nhóm “Thấp” chiếm 29,811 (≈20%).
Ứng dụng phân tích: Việc nhóm lại giúp đơn giản hóa biến và tạo điều kiện cho:
Phân tích mối quan hệ giữa trình độ học vấn và thu nhập
So sánh tỷ lệ việc làm/thất nghiệp theo từng nhóm trình độ
Xây dựng mô hình dự báo với biến phân loại có thứ tự rõ ràng
Ý nghĩa thực tiễn: Phân bổ này phù hợp với cấu trúc trình độ của lực lượng lao động tại Hoa Kỳ, nơi đa số người lao động có trình độ từ trung học đến đại học, và tỷ lệ có trình độ cao khá phổ biến.
df <- df %>%
mutate(
Tình_trạng_hôn_nhân = case_when(
marst %in% c("Married, spouse present", "Married, spouse absent", "Separated") ~ "Đã kết hôn",
marst %in% c("Single", "Widowed", "Divorced") ~ "Độc thân",
TRUE ~ "Khác"
)
)
df$Tình_trạng_hôn_nhân <- factor(df$Tình_trạng_hôn_nhân, levels = c("Đã kết hôn", "Độc thân", "Khác"))
df %>%
count(Tình_trạng_hôn_nhân, name = "Số lượng") %>%
knitr::kable(caption = "Tần số trạng thái hôn nhân (đã nhóm)")
| Tình_trạng_hôn_nhân | Số lượng |
|---|---|
| Đã kết hôn | 66475 |
| Độc thân | 79198 |
Giải thích kỹ thuật
case_when(…): Thực hiện ánh xạ có điều kiện để nhóm các tình trạng hôn nhân chi tiết thành 2 nhóm chính:
“Married, spouse present”, “Married, spouse absent”, “Separated” → “Đã kết hôn” (bao gồm cả đang sống cùng vợ/chồng, không sống cùng và ly thân)
“Single”, “Widowed”, “Divorced” → “Độc thân” (bao gồm chưa kết hôn, góa và đã ly dị)
Các trường hợp khác → “Khác”
factor(…, levels = c(“Đã kết hôn”, “Độc thân”, “Khác”)): Chuyển biến mới thành factor với thứ tự levels được xác định trước, giúp:
Kiểm soát thứ tự hiển thị trong các biểu đồ và bảng biểu
Đảm bảo tính nhất quán trong các phân tích thống kê
count(Tình_trạng_hôn_nhân, name = “Số lượng”): Đếm tần suất quan sát cho từng nhóm tình trạng hôn nhân sau khi nhóm.
Ý nghĩa thống kê
Phân bổ hôn nhân: Dữ liệu cho thấy sự phân chia tương đối cân bằng giữa hai nhóm chính:
Nhóm “Độc thân” chiếm tỷ lệ cao hơn (79,198 - ≈54%), phản ánh xu hướng xã hội hiện đại với tỷ lệ kết hôn giảm và độc thân tăng
Nhóm “Đã kết hôn” chiếm 66,475 (≈46%), bao gồm cả các trường hợp đang kết hôn nhưng không sống cùng nhau hoặc ly thân
Nhóm “Khác” không có quan sát nào, cho thấy việc phân loại đã bao phủ toàn bộ dữ liệu
Ứng dụng phân tích: Việc nhóm lại này có ý nghĩa quan trọng trong:
Phân tích mối quan hệ giữa tình trạng hôn nhân và thu nhập, việc làm
Nghiên cứu về quyết định tham gia lực lượng lao động theo tình trạng hôn nhân
Phân tích các yếu tố nhân khẩu học ảnh hưởng đến thị trường lao động
Ý nghĩa thực tiễn: Tỷ lệ độc thân cao hơn đã kết hôn phù hợp với xu hướng nhân khẩu học tại Hoa Kỳ, nơi ngày càng nhiều người lựa chọn sống độc thân, kết hôn muộn hoặc không kết hôn.
df <- df %>%
mutate(
Chủng_tộc = case_when(
race %in% c("White") ~ "Da trắng",
race %in% c("Black") ~ "Da đen",
race %in% c("Asian") ~ "Châu Á",
race %in% c("Pacific Islander") ~ "Người đảo Thái Bình Dương",
race %in% c("American Indian") ~ "Người bản địa Mỹ",
race %in% c("Multiracial") ~ "Đa chủng tộc",
TRUE ~ "Khác"
)
)
df$Chủng_tộc <- factor(df$Chủng_tộc, levels = c("Da trắng", "Da đen", "Châu Á", "Người đảo Thái Bình Dương","Người bản địa Mỹ", "Đa chủng tộc", "Khác"))
df %>%
count(Chủng_tộc, name = "Số lượng") %>%
knitr::kable(caption = "Tần số chủng tộc (đã nhóm)")
| Chủng_tộc | Số lượng |
|---|---|
| Da trắng | 111253 |
| Da đen | 17160 |
| Châu Á | 10702 |
| Người đảo Thái Bình Dương | 3560 |
| Người bản địa Mỹ | 2193 |
| Đa chủng tộc | 805 |
Giải thích kỹ thuật
case_when(…): Thực hiện ánh xạ có điều kiện để chuẩn hóa và nhóm các chủng tộc:
Xử lý các viết hoa/viết thường khác nhau (White/white/WHITE) → “Da trắng”
Phân loại thành 6 nhóm chủng tộc chính với tên gọi chuẩn hóa
Dùng TRUE ~ “Khác” để xử lý các trường hợp ngoại lệ (nếu có)
factor(…, levels = c(…)): Chuyển biến thành factor với thứ tự levels được xác định trước, giúp:
Sắp xếp thứ tự hiển thị hợp lý trong biểu đồ và bảng biểu
Kiểm soát thứ tự trong các phân tích thống kê
Ưu tiên nhóm đông nhất (Da trắng) lên đầu
count(Chủng_tộc, name = “Số lượng”): Đếm tần suất quan sát cho từng nhóm chủng tộc sau khi chuẩn hóa.
Ý nghĩa thống kê
Phân bổ chủng tộc: Dữ liệu cho thấy cấu trúc đa dạng về chủng tộc:
Da trắng chiếm đa số tuyệt đối (111,253 - ≈76%), phản ánh cấu trúc dân số Hoa Kỳ
Da đen chiếm 17,160 (≈12%), là nhóm thiểu số lớn thứ hai
Châu Á chiếm 10,702 (≈7%), thể hiện cộng đồng người gốc Á đáng kể
Các nhóm còn lại chiếm tỷ lệ nhỏ: Người đảo Thái Bình Dương (2.4%), Người bản địa Mỹ (1.5%), Đa chủng tộc (0.6%)
Ứng dụng phân tích: Việc chuẩn hóa này có ý nghĩa quan trọng trong:
Phân tích bất bình đẳng thu nhập theo chủng tộc
Nghiên cứu sự khác biệt về cơ hội việc làm và nghề nghiệp
Phân tích đa văn hóa trong thị trường lao động
Nghiên cứu về phân biệt đối xử trong lao động
Ý nghĩa thực tiễn: Phân bổ này phản ánh đúng cấu trúc đa dạng chủng tộc của Hoa Kỳ, cung cấp nền tảng cho các phân tích về công bằng xã hội và chính sách lao động đa văn hóa.
Việc chuẩn hóa các biến định tính giúp dữ liệu gọn gàng, dễ đọc và thuận lợi cho việc trực quan hóa, mô hình hóa hồi quy sau này.
df <- df %>%
mutate(age = as.numeric(age),
Nhóm_tuổi = case_when(
age < 25 ~ "Dưới 25",
age >= 25 & age < 40 ~ "25–39",
age >= 40 & age < 60 ~ "40–59",
age >= 60 ~ "Từ 60 trở lên",
TRUE ~ "Không xác định"
))
df$Nhóm_tuổi <- factor(df$Nhóm_tuổi,
levels = c("Dưới 25", "25–39", "40–59", "Từ 60 trở lên"))
df %>%
count(Nhóm_tuổi, name = "Số lượng") %>%
knitr::kable(caption ="Tần số các nhóm tuổi")
| Nhóm_tuổi | Số lượng |
|---|---|
| Dưới 25 | 47603 |
| 25–39 | 28110 |
| 40–59 | 36195 |
| Từ 60 trở lên | 33765 |
Giải thích kỹ thuật
mutate(age = as.numeric(age)): Đảm bảo biến tuổi ở dạng số để thực hiện so sánh số học
case_when(…): Phân chia tuổi thành 4 nhóm có ý nghĩa nhân khẩu học:
age < 25 → “Dưới 25” (Thanh niên, mới gia nhập thị trường lao động)
age >= 25 & age < 40 → “25–39” (Độ tuổi sự nghiệp phát triển)
age >= 40 & age < 60 → “40–59” (Trung niên, giai đoạn ổn định)
age >= 60 → “Từ 60 trở lên” (Gần nghỉ hưu hoặc đã nghỉ hưu)
factor(…, levels = c(…)): Chuyển thành factor có thứ tự theo tuổi tăng dần, đảm bảo hiển thị đúng trình tự trong biểu đồ và phân tích
Ý nghĩa thống kê
Phân bổ nhân khẩu học:
Nhóm “Dưới 25” chiếm tỷ lệ cao nhất (47,603 - ≈32.6%), phản ánh lượng lớn người trẻ trong độ tuổi học đại học hoặc mới bắt đầu sự nghiệp
Nhóm “40–59” chiếm 36,195 (≈24.8%) - lực lượng lao động chính có kinh nghiệm
Nhóm “25–39” chiếm 28,110 (≈19.2%) - đang trong giai đoạn thăng tiến sự nghiệp
Nhóm “Từ 60 trở lên” chiếm 33,765 (≈23.1%) - phản ánh xu hướng già hóa dân số và người cao tuổi vẫn tham gia thị trường lao động
Ứng dụng phân tích:
Phân tích sự khác biệt về thu nhập, nghề nghiệp theo độ tuổi
Nghiên cứu tỷ lệ thất nghiệp theo các giai đoạn sự nghiệp
Phân tích chuyển đổi nghề nghiệp qua các nhóm tuổi
Đánh giá tác động của tuổi tác đến quyết định tham gia lực lượng lao động
Ý nghĩa chính sách: Cấu trúc tuổi đa dạng cho thấy nhu cầu về các chính sách lao động phù hợp cho từng nhóm tuổi, từ đào tạo nghề cho người trẻ đến chính sách việc làm linh hoạt cho người cao tuổi.
df <- df %>%
mutate(
fulltime_bin = ifelse(fullpart == "Full-time", 1,
ifelse(fullpart == "Part-time", 0, NA))
)
df %>%
count(fullpart, fulltime_bin, name = "Số lượng") %>%
knitr::kable(caption = "Biến nhị phân fulltime_bin (1 = Full-time, 0 = Part-time)")
| fullpart | fulltime_bin | Số lượng |
|---|---|---|
| Full-time | 1 | 59411 |
| Not working | NA | 72947 |
| Part-time | 0 | 13315 |
Giải thích kỹ thuật
ifelse(fullpart == “Full-time”, 1, ifelse(fullpart == “Part-time”, 0, NA)): Sử dụng hàm ifelse lồng nhau để mã hóa nhị phân:
Nếu fullpart = “Full-time” → gán giá trị 1
Nếu fullpart = “Part-time” → gán giá trị 0
Các trường hợp khác (“Not working”) → gán giá trị NA (không xác định)
Cấu trúc ifelse lồng nhau: Cho phép xử lý nhiều điều kiện cùng lúc, với cú pháp: ifelse(condition, value_if_true, value_if_false)
Sử dụng NA: Nhóm “Not working” được gán NA vì không thuộc phân loại full-time/part-time, tránh làm nhiễu dữ liệu trong phân tích nhị phân
Ý nghĩa thống kê
Phân bổ làm việc:
Full-time: 59,411 người (≈44% trong số người có việc làm)
Part-time: 13,315 người (≈10% trong số người có việc làm)
Not working: 72,947 người (≈46% toàn bộ mẫu) - được loại khỏi phân tích nhị phân
Ứng dụng phân tích:
Mô hình hồi quy logistic: Dùng fulltime_bin làm biến phụ thuộc để phân tích các yếu tố ảnh hưởng đến việc làm full-time
So sánh nhóm: Phân tích sự khác biệt về thu nhập, ngành nghề, nhân khẩu học giữa người làm full-time và part-time
Phân tích chính sách: Đánh giá tác động của các chính sách lao động đến tỷ lệ việc làm full-time
Ưu điểm của biến nhị phân:
Đơn giản hóa phân tích cho các mô hình nhị phân
Dễ diễn giải kết quả (odds ratio, probability)
Phù hợp cho các bài toán phân loại và dự báo
Lưu ý: Khi phân tích với biến này, cần lọc bỏ hoặc xử lý các giá trị NA để đảm bảo kết quả chính xác.
df <- df %>%
mutate(
sex_emp_interact = paste(sex, empstat, sep = "_")
)
df %>%
select(sex, empstat, sex_emp_interact) %>%
head(10) %>%
knitr::kable(caption = "Biến tương tác giới tính × tình trạng việc làm")
| sex | empstat | sex_emp_interact |
|---|---|---|
| Female | Not in labor force | Female_Not in labor force |
| Female | Not in labor force | Female_Not in labor force |
| Female | Not in labor force | Female_Not in labor force |
| Male | Employed | Male_Employed |
| Female | Not in labor force | Female_Not in labor force |
| Male | Not in labor force | Male_Not in labor force |
| Female | Not in labor force | Female_Not in labor force |
| Female | Not in labor force | Female_Not in labor force |
| Male | Not in labor force | Male_Not in labor force |
| Male | Not in labor force | Male_Not in labor force |
Giải thích kỹ thuật
paste(sex, empstat, sep = “_“): Kết hợp hai biến categorical thành một biến tương tác duy nhất bằng hàm paste():
Tham số: sex và empstat là hai biến đầu vào, sep = “_” xác định ký tự phân cách giữa các giá trị
Kết quả: Tạo ra các tổ hợp duy nhất như “Female_Employed”, “Male_Unemployed”, etc.
Kiểu dữ liệu: Kết quả là biến character, có thể chuyển thành factor nếu cần
Ý nghĩa thống kê
Phát hiện tương tác: Biến tương tác cho phép phân tích hiệu ứng kết hợp giữa giới tính và tình trạng việc làm:
Không chỉ xem xét tác động riêng lẻ của giới tính hay việc làm lên thu nhập
Mà còn phân tích xem ảnh hưởng của giới tính lên thu nhập có khác nhau giữa các nhóm việc làm không
Ý nghĩa thực tiễn:
Phát hiện bất bình đẳng giới trong từng nhóm việc làm cụ thể
Phân tích khoảng cách thu nhập giữa nam và nữ trong cùng trạng thái việc làm
Nghiên cứu sự khác biệt về cơ hội việc làm theo giới tính
Ví dụ cụ thể từ dữ liệu: Có thể phân tích xem khoảng cách thu nhập giữa nam và nữ có lớn hơn trong nhóm employed so với unemployed hay không, hoặc tỷ lệ thất nghiệp có khác biệt đáng kể theo giới tính.
Phân bố tổng quan của các biến trong tập dữ liệu
# 1. Phân bố các biến định tính
important_vars <- df %>% select(sex, race, marst, empstat, educ, fullpart)
plot_bar(important_vars, title = "Phân bố các biến định tính chính")
# 2. Phân bố các biến định lượng
plot_histogram(df, title = "Phân bố của các biến định lượng")
Mục tiêu: Cung cấp cái nhìn toàn cảnh về đặc điểm nhân khẩu học và phân bố thu nhập của toàn bộ mẫu.
# 1. Thống kê mô tả biến tuổi
summary(df$age)
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0 18.0 38.0 38.7 58.0 85.0
# 2. Trung bình và độ lệch chuẩn tuổi
mean(df$age, na.rm=TRUE)
[1] 38.70309
sd(df$age, na.rm=TRUE)
[1] 23.33852
# 3. Biểu đồ histogram của tuổi
hist(df$age, main="Phân bố độ tuổi", xlab="Tuổi", ylab = "Tần suất", col="lightgreen", border="white")
# 1. Bảng chéo giữa giới tính và tình trạng việc làm
table(df$sex, df$empstat)
Employed NIU Not in labor force Unemployed
Female 32910 14293 26400 1087
Male 35800 15190 18610 1383
# 2. Thống kê tần suất theo tình trạng việc làm
bang_tansuat <- df %>%
count(empstat, name = "Tan_suat") %>%
mutate(Ty_le = round(Tan_suat / sum(Tan_suat) * 100, 2))
kable(
bang_tansuat,
caption = "Thống kê tần suất và tỷ lệ theo tình trạng việc làm (%)"
)
| empstat | Tan_suat | Ty_le |
|---|---|---|
| Employed | 68710 | 47.17 |
| NIU | 29483 | 20.24 |
| Not in labor force | 45010 | 30.90 |
| Unemployed | 2470 | 1.70 |
# 1. Trung bình thu nhập cá nhân
mean(df$incwage, na.rm=TRUE)
[1] 23616.89
# 2. Độ lệch chuẩn và trung vị thu nhập
sd(df$incwage, na.rm=TRUE)
[1] 35107.79
median(df$incwage, na.rm=TRUE)
[1] 0
# 1. Histogram thu nhập
hist(df$incwage, main="Phân bố thu nhập cá nhân", xlab="Thu nhập", ylab = "Tần suất", col="orange", border="white")
# 2. Biểu đồ density (mật độ) thu nhập theo giới tính
ggplot(df, aes(x = incwage, fill = sex)) +
geom_density(alpha = 0.5) +
scale_fill_brewer(palette = "Pastel1") +
labs(title = "Mật độ thu nhập theo giới tính",
x = "Thu nhập", y = "Mật độ", fill = "Giới tính") +
theme_minimal() +
coord_cartesian() +
scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
Mục tiêu: Đi sâu so sánh sự khác biệt và mối quan hệ của từng yếu tố với thu nhập.
# 1. So sánh thu nhập trung bình theo giới tính.
tapply(df$incwage, df$sex, mean, na.rm=TRUE)
Female Male
20202.69 27300.78
# 2. Bar chart biểu đồ tỷ lệ thu nhập cao/thấp theo giới tính và hôn nhân.
# B1. Tạo biến "income_group" (cao/thấp)
df_for_plot <- df %>%
mutate(income_group = ifelse(incwage > median(incwage, na.rm = TRUE), "Cao", "Thấp"))
# B2. Vẽ biểu đồ Bar Chart
ggplot(df_for_plot, aes(x = sex, fill = income_group)) + # LAYER 1 & 2
geom_bar(position = "fill") + # LAYER 3
facet_wrap(~ Tình_trạng_hôn_nhân) + # LAYER 4
labs(title = "Tỷ lệ thu nhập (cao/thấp) theo giới tính và hôn nhân",
x = "Giới tính",
y = "Tỷ lệ",
fill = "Nhóm thu nhập") + # LAYER 5 (nhãn)
theme_minimal()
# 3. Bar plot thu nhập trung bình theo giới tính (có CI).
# 1. So sánh thu nhập trung bình theo tình trạng hôn nhân
tapply(df$incwage, df$marst, mean, na.rm=TRUE)
Divorced Married, spouse absent Married, spouse present
29787.748 27884.507 37122.676
Separated Single Widowed
8153.787 12602.455 26215.861
# 2. Violin plot phân bố thu nhập theo tình trạng hôn nhân
ggplot(df, aes(x = marst, y = incwage, fill = marst)) +
geom_violin(trim = FALSE, alpha = 0.7) + # Layer 1
geom_boxplot(width = 0.1, fill = "white", alpha = 0.6, outlier.shape = NA) + # Layer 2
scale_fill_brewer(palette = "Set2") + # Layer 3
labs(title = "Phân bố thu nhập theo tình trạng hôn nhân", x = "Tình trạng hôn nhân", y = "Thu nhập", fill = "Tình trạng hôn nhân") + # Layer 4
theme_classic() + coord_flip() # Layer 5
# 1. Biểu đồ thu nhập trung bình theo chủng tộc
df %>%
group_by(race) %>%
summarise(mean_income = mean(incwage, na.rm = TRUE)) %>%
ggplot(aes(x = reorder(race, mean_income), y = mean_income, fill = race)) +
geom_col(alpha = 0.8) + # Layer 1
geom_text(aes(label = round(mean_income, 0)),
hjust = -0.05, size = 3.5, color = "black") + # Layer 2
scale_fill_brewer(palette = "Set2") + # Layer 3
labs(title = "Thu nhập trung bình theo chủng tộc",
x = "Chủng tộc", y = "Thu nhập trung bình", fill = "Chủng tộc") + # Layer 4
theme_minimal() +
coord_flip() + # Layer 5
scale_y_continuous(limits = c(0, 40000))
# 2. Boxplot thu nhập theo chủng tộc
df %>%
ggplot(aes(x = reorder(race, incwage, FUN = median), y = incwage, fill = race)) +
geom_boxplot(alpha = 0.7, outlier.shape = NA) + # Layer 1
scale_fill_brewer(palette = "Set2") + # Layer 2
labs(title = "Phân bố thu nhập theo chủng tộc",
x = "Chủng tộc",
y = "Thu nhập",
fill = "Chủng tộc") + # Layer 3
theme_minimal() + # Layer 4
coord_flip() + # Layer 5
coord_cartesian(ylim = c(0, 150000)) # Layer 6
# 1. So sánh thu nhập trung bình giữa nhóm làm việc full-time và part-time
tapply(df$incwage, df$fullpart, mean, na.rm=TRUE)
Full-time Not working Part-time
55998.91 0.00 17486.34
# 2. Phân tích chéo: giới tính × loại hình công việc (full/part-time)
table(df$sex, df$fullpart)
Full-time Not working Part-time
Female 26512 39767 8411
Male 32899 33180 4904
# 3. Trung bình thu nhập theo giới tính và tình trạng việc làm
aggregate(incwage ~ sex + empstat, data = df, mean, na.rm=TRUE)
# 4. Biểu đồ thu nhập trung bình theo giới tính và việc làm
df %>%
group_by(empstat) %>%
summarise(mean_income = mean(incwage, na.rm = TRUE)) %>%
ggplot(aes(x = reorder(empstat, mean_income), y = mean_income, fill = empstat)) +
geom_col(alpha = 0.8) + # Layer 1
geom_text(aes(label = round(mean_income, 0)), hjust = -0.1) + # Layer 2
scale_fill_brewer(palette = "Set2") + # Layer 3
labs(title = "Thu nhập trung bình theo tình trạng việc làm", x = "Tình trạng việc làm", y = "Thu nhập trung bình", fill = "Tình trạng việc làm") + # Layer 4
theme_bw() + coord_flip() + # Layer 5
scale_y_continuous(limits = c(0, 70000))
# 1. Biểu đồ cột thu nhập theo học vấn.
ggplot(df, aes(x = educ, y = incwage)) +
stat_summary(fun = mean, geom = "bar", fill = "skyblue") +
labs(
title = "Thu nhập trung bình theo trình độ học vấn",
x = "Trình độ học vấn",
y = "Thu nhập trung bình"
) +
theme_minimal()
# 2. Boxplot thu nhập theo nhóm học vấn.
boxplot(log(incwage + 1) ~ Trình_độ_học_vấn,
data = df,
main = "Phân bố log(Thu nhập) theo trình độ học vấn",
xlab = "Trình độ học vấn",
ylab = "log(Thu nhập)",
col = c("lightblue", "lightgreen", "salmon"),
border = "gray40",
notch = TRUE,
outline = FALSE)
# 3. Boxplot thu nhập theo học vấn
ggplot(df, aes(x = reorder(educ, incwage, FUN = median), y = incwage, fill = educ)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7, color = "gray40", width = 0.6) + # Layer 1: boxplot, ẩn outlier
stat_summary(fun = mean, geom = "point", color = "red", size = 2.5) + # Layer 2: điểm trung bình
scale_fill_brewer(palette = "Pastel1", name = "Trình độ học vấn") + # Layer 3: bảng màu
scale_y_continuous(labels = scales::comma, limits = c(0, quantile(df$incwage, 0.95, na.rm = TRUE))) + # Layer 4: chuẩn hóa trục y
labs(
title = "Phân bố thu nhập theo trình độ học vấn",
x = "Trình độ học vấn",
y = "Thu nhập (USD)"
) +
coord_flip() + # Layer 5: lật ngang
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
legend.position = "none"
)
# 4. Trung bình thu nhập theo nhóm học vấn (đã chuẩn hoá)
df_clean <- df %>%
filter(!is.na(incwage), !is.na(Trình_độ_học_vấn))
nrow(df_clean) #Kiểm tra xem còn bao nhiêu dòng
[1] 141893
tb_hocvan_df <- df_clean %>%
group_by(Trình_độ_học_vấn) %>%
summarise(
Số_người = n(),
Thu_nhập_trung_bình = mean(incwage, na.rm = TRUE),
Thu_nhập_trung_vị = median(incwage, na.rm = TRUE),
Độ_lệch_chuẩn = sd(incwage, na.rm = TRUE)
)
kable(
tb_hocvan_df,
caption = "Thu nhập trung bình theo nhóm học vấn",
digits = 2
)
| Trình_độ_học_vấn | Số_người | Thu_nhập_trung_bình | Thu_nhập_trung_vị | Độ_lệch_chuẩn |
|---|---|---|---|---|
| Thấp | 29811 | 87.70 | 0 | 1794.86 |
| Trung bình | 66601 | 20014.96 | 1200 | 28291.91 |
| Cao | 45481 | 44313.91 | 40000 | 43138.33 |
# 5. Biểu đồ tỷ lệ thu nhập cao theo học vấn.
df %>%
mutate(High_income = ifelse(incwage > median(incwage, na.rm = TRUE), "Cao", "Thấp")) %>%
group_by(educ, High_income) %>%
summarise(Count = n(), .groups = "drop") %>%
mutate(Ty_le = Count / sum(Count) * 100) %>%
ggplot(aes(x = educ, y = Ty_le, fill = High_income)) +
geom_col(position = "fill") + # Layer 1
scale_y_continuous(labels = scales::percent) + # Layer 2
scale_fill_manual(values = c("#66c2a5", "#fc8d62")) + # Layer 3
labs(title = "Tỷ lệ thu nhập cao/thấp theo học vấn", x = "Trình độ học vấn", y = "Tỷ lệ (%)", fill = "Nhóm thu nhập") + # Layer 4
theme_minimal() + coord_flip() # Layer 5
Mục tiêu: Khám phá sự kết hợp phức tạp của nhiều yếu tố cùng lúc tác động đến thu nhập.
# 1. Tính Hệ số tương quan giữa tuổi và thu nhập
cor(df$age, df$incwage, use = "complete.obs")
[1] 0.1531655
# 2. Biểu đồ Scatter plot thêm đường hồi quy tuyến tính giữa tuổi và thu nhập
plot(df$age, df$incwage,
main = "Mối quan hệ giữa tuổi và thu nhập",
xlab = "Tuổi", ylab = "Thu nhập",
pch = 19, col = "steelblue")
# Thêm đường hồi quy tuyến tính
model_age <- lm(incwage ~ age, data = df)
abline(model_age, col = "red", lwd = 2)
# 3. Biểu đồ đường thu nhập trung bình theo độ tuổi
df %>%
group_by(Nhóm_tuổi) %>%
summarise(mean_income = mean(incwage, na.rm = TRUE)) %>%
ggplot(aes(x = Nhóm_tuổi, y = mean_income, group = 1)) +
geom_line(color = "steelblue", size = 1.2) + # Layer 1
geom_point(color = "steelblue", size = 3) + # Layer 2
geom_text(aes(label = round(mean_income, 0)),
vjust = 1.5, size = 4, color = "black") +
labs(title = "Thu nhập trung bình theo nhóm tuổi",
x = "Nhóm tuổi",
y = "Thu nhập trung bình") + # Layer 4
theme_minimal() + # Layer 5
scale_y_continuous(labels = scales::number_format(big.mark = ""))
# 1. Phân tích thu nhập trung bình theo giới tính và nhóm học vấn
aggregate(incwage ~ sex + Trình_độ_học_vấn, data = df, mean, na.rm=TRUE)
# 2. Bar plot 3 chiều (facet_grid) giữa học vấn, giới tính và thu nhập trung bình
df %>%
group_by(sex, Trình_độ_học_vấn) %>%
summarise(mean_income = mean(incwage, na.rm = TRUE), .groups = 'drop') %>%
ggplot(aes(x = Trình_độ_học_vấn, y = mean_income, fill = sex)) + # THAY ĐỔI: x = Trình_độ_học_vấn
geom_col(alpha = 0.8, position = "dodge") + # THAY ĐỔI: position = "dodge"
geom_text(aes(label = round(mean_income, 0)),
position = position_dodge(0.9), vjust = -0.5, size = 3.5) + # THAY ĐỔI: thêm position_dodge
scale_fill_brewer(palette = "Set2") + # Layer 3 - Màu sắc
labs(title = "Thu nhập trung bình theo giới tính và trình độ học vấn",
x = "Trình độ học vấn", # THAY ĐỔI: x = Trình độ học vấn
y = "Thu nhập trung bình",
fill = "Giới tính") + # Layer 4 - Nhãn
theme_minimal() + # Layer 5 - Theme
scale_y_continuous(labels = scales::number_format(big.mark = ""))
# 3. Density plot với giới hạn rõ ràng
ggplot(df %>% filter(incwage > 0 & incwage <= 150000), aes(x = incwage, fill = sex)) +
geom_density(alpha = 0.5) + # Layer 1
facet_wrap(~ Trình_độ_học_vấn, ncol = 1) + # Layer 2
scale_fill_brewer(palette = "Set2") + # Layer 3
labs(title = "Mật độ thu nhập theo trình độ học vấn và giới tính",
x = "Thu nhập",
y = "Mật độ",
fill = "Giới tính") + # Layer 4
theme_minimal() + # Layer 5
scale_x_continuous(labels = scales::number_format(big.mark = ""))+
scale_y_continuous(labels = scales::number_format(big.mark = ""))
# 1. Heatmap thu nhập trung bình theo học vấn và việc làm.
df %>%
group_by(educ, empstat) %>%
summarise(mean_inc = mean(incwage, na.rm = TRUE), .groups = 'drop') %>%
mutate(empstat = factor(empstat, levels = c("Employed", "Unemployed", "Not in labor force", "NIU"))) %>% # Sắp xếp thứ tự
ggplot(aes(x = educ, y = empstat, fill = mean_inc)) +
geom_tile(color = "white") + # Layer 1: heatmap
scale_fill_gradient(low = "lightyellow", high = "red") + # Layer 2: thang màu
geom_text(aes(label = round(mean_inc, 0)), color = "black", size = 3) + # Layer 3
labs(
title = "Thu nhập trung bình theo học vấn và tình trạng việc làm",
x = "Trình độ học vấn",
y = "Tình trạng việc làm",
fill = "Thu nhập trung bình"
) + # Layer 4
theme_light() + # Layer 5
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_cartesian()
# 2. Boxplot thu nhập theo việc làm, chia màu theo trình độ học vấn (đã chuẩn hóa)
ggplot(df, aes(x = Tình_trạng_việc_làm, y = incwage, fill = Trình_độ_học_vấn)) +
geom_boxplot(alpha = 0.7, outlier.shape = NA) + # Layer 1
scale_fill_brewer(palette = "Set2") + # Layer 2
labs(title = "Thu nhập theo tình trạng việc làm và trình độ học vấn",
x = "Tình trạng việc làm",
y = "Thu nhập",
fill = "Trình độ học vấn") + # Layer 3
theme_minimal() + # Layer 4
scale_y_continuous(labels = scales::number_format(big.mark = ""), # Layer 5
limits = c(0, 100000)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# 1. Biểu đồ phân tán thu nhập theo tuổi và nhóm học vấn.
ggplot(df %>% filter(!is.na(age), !is.na(incwage), !is.na(Trình_độ_học_vấn)),
aes(x = age, y = incwage, color = Trình_độ_học_vấn)) +
geom_point(alpha = 0.2, size = 1) + # Layer 1 - GIẢM ALPHA VÀ SIZE
geom_smooth(aes(group = Trình_độ_học_vấn), method = "lm", se = FALSE,
lwd = 1.5) + #Layer 2
scale_color_brewer(palette = "Set2") + # Layer 3
labs(
title = "Quan hệ giữa tuổi và thu nhập theo nhóm học vấn",
x = "Tuổi",
y = "Thu nhập cá nhân (incwage)",
color = "Nhóm học vấn"
) + # Layer 4
theme_classic(base_size = 13) + # Layer 5
coord_cartesian(ylim = c(0, quantile(df$incwage, 0.99, na.rm = TRUE)[[1]])) +
scale_y_continuous(labels = scales::number_format(big.mark = ""))
# 2. Scatter plot đa biến (Tuổi – Thu nhập – Học vấn).
ggplot(df, aes(x = age, y = incwage, color = educ)) +
geom_point(alpha = 0.2, size = 1) + # Layer 1 - GIẢM ALPHA VÀ SIZE
geom_smooth(method = "lm", se = FALSE, lwd = 0.7) + # Layer 2
scale_color_brewer(palette = "Set2") + # Layer 3
labs(title = "Tuổi – Thu nhập – Học vấn",
x = "Tuổi", y = "Thu nhập", color = "Học vấn") + # Layer 4
theme_bw() # Layer 5
# 3. Pairs plot (quan hệ nhiều biến).
pairs(~ age + incwage, data = df,
main = "Quan hệ giữa các biến định lượng",
col = "blue", pch = 19)
# 4. Biểu đồ tương tác học vấn – giới tính – thu nhập.
ggplot(df, aes(x = reorder(educ, incwage, FUN = median), y = incwage, fill = sex)) +
geom_boxplot(
position = position_dodge(width = 0.8),
alpha = 0.7,
outlier.shape = NA, # Layer 1: ẩn giá trị ngoại lai
width = 0.6,
color = "gray40"
) +
stat_summary(
fun = mean,
geom = "point",
position = position_dodge(width = 0.8),
shape = 18, size = 2.5, color = "black"
) + # Layer 2: điểm trung bình
scale_fill_brewer(palette = "Set2", name = "Giới tính") + # Layer 3: bảng màu
scale_y_continuous(
labels = scales::comma,
limits = c(0, quantile(df$incwage, 0.95, na.rm = TRUE))
) + # Layer 4: trục y chuẩn hóa
labs(
title = "Tương tác giữa trình độ học vấn-giới tính-thu nhập",
x = "Trình độ học vấn",
y = "Thu nhập (USD)"
) +
coord_flip() + # Layer 5: lật ngang
theme_light(base_size = 13) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
legend.position = "top"
)
df %>%
mutate(age_group = cut(age, breaks = c(0, seq(15, 80, 5), 100),
include.lowest = TRUE)) %>%
group_by(age_group, sex) %>%
summarise(mean_income = mean(incwage, na.rm = TRUE)) %>%
ggplot(aes(x = age_group, y = sex, fill = mean_income)) +
geom_tile(color = "white", width = 0.9, height = 0.9) + # Layer 1
geom_text(aes(label = round(mean_income, 0)), # Layer 2
color = "black", size = 2.8) +
scale_fill_gradient(low = "lightblue", high = "darkred") + # Layer 3: Thang màu
labs(
title = "Thu nhập trung bình theo nhóm tuổi và giới tính",
x = "Nhóm tuổi",
y = "Giới tính",
fill = "Thu nhập TB"
) + # Layer 4
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) + # Xoay chữ trục x 45 độ
coord_cartesian(expand = FALSE) # Layer 5