Nội dung của chương này tập trung vào việc thực hiện Khám phá dữ liệu sơ bộ (Exploratory Data Analysis - EDA) trên bộ dữ liệu về Lực lượng Lao động Hoa Kỳ năm 2023. Các thao tác được thực hiện một cách tuần tự, từ việc tải và chuẩn bị dữ liệu, kiểm tra cấu trúc và chất lượng, cho đến các bước xử lý và mã hóa biến. Mục tiêu là xây dựng một nền tảng hiểu biết vững chắc về dữ liệu trước khi tiến hành các phân tích thống kê chuyên sâu và trực quan hóa..
df_raw <- read_excel("data_2023_hoaKy.xlsx")
df <- df_raw %>%
clean_names()
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 |
factor_vars <- c("sex", "race", "marst", "empst", "occ", "ind", "educ", "fullpart","empstat")
factor_vars <- factor_vars[factor_vars %in% names(df)]
df <- df %>%
mutate(across(where(is.character), as.factor))
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,…
Quá trình phân tích bắt đầu bằng việc nhập dữ liệu từ file data_2023_hoaKy.xlsx vào môi trường R bằng hàm read_excel(). Để đảm bảo tính nhất quán và tuân thủ quy tắc đặt tên biến trong R, hàm clean_names() từ gói janitor đã được áp dụng để chuẩn hóa tên các cột. Sáu quan sát đầu tiên được hiển thị thông qua hàm head() để có cái nhìn trực quan ban đầu về cấu trúc dữ liệu. Cuối cùng, để tối ưu hóa cho các phân tích thống kê, các biến có kiểu dữ liệu character đã được chuyển đổi sang kiểu factor bằng hàm mutate() và across(). Thao tác này giúp R nhận diện chính xác các biến định tính, tạo điều kiện thuận lợi cho việc phân nhóm và trực quan hóa sau này.
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 ...
Hàm str() (structure) được sử dụng để kiểm tra cấu trúc chi tiết của dataframe. Kết quả cung cấp thông tin về kiểu dữ liệu của từng biến (fct cho factor, dbl cho số thực), xác nhận rằng các bước chuẩn bị dữ liệu ban đầu đã được thực hiện thành công và dữ liệu đã sẵn sàng cho các bước tiếp theo.
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.
Kết quả từ hàm nrow() và ncol() cho thấy bộ dữ liệu có quy mô lớn, bao gồm 146,133 quan sát và 10 biến. Kích thước mẫu lớn này cung cấp một nền tảng vững chắc, đảm bảo tính đại diện và độ tin cậy thống kê cho các kết luận được rút ra từ phân tích.
names(df)
[1] "age" "sex" "race" "marst" "empstat" "occ"
[7] "ind" "educ" "fullpart" "incwage"
head(df)
Việc kiểm tra lại tên biến bằng names() và dữ liệu mẫu bằng head() là một bước xác thực cuối cùng, đảm bảo rằng dữ liệu đã được tải vào một cách chính xác và các tên biến đã được chuẩn hóa đúng như mong đợi.
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.
Chất lượng dữ liệu là một yếu tố quan trọng ảnh hưởng đến độ tin cậy của phân tích. Kết quả từ việc sử dụng hàm colSums(is.na(df)) cho thấy bộ dữ liệu không chứa bất kỳ giá trị bị thiếu (NA) nào. Điều này là một tín hiệu rất tích cực, cho phép chúng ta tiến hành phân tích mà không cần áp dụng các kỹ thuật xử lý dữ liệu thiếu phức tạp.
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
# Thống kê tần suất xuất hiện của từng dòng (xét toàn bộ biến)
duplicated_summary <- df %>%
group_by(across(everything())) %>%
summarise(Frequency = n(), .groups = "drop") %>%
arrange(desc(Frequency))
# Hiển thị 10 dòng đầu tiên trong bảng tần suất
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 |
|---|---|---|---|---|---|---|---|---|---|---|
| 26 | Female | White | Single | Employed | Retail salespersons | Gift, novelty, and souvenir shops | Graduate degree | Part-time | 11200 | 1 |
| 57 | Female | White | Single | Employed | Teaching assistants | Elementary and secondary schools | Associate degree | Full-time | 41000 | 1 |
| 75 | Male | White | Separated | Employed | Animal caretakers | Veterinary services | Graduate degree | Part-time | 6000 | 1 |
| 41 | Female | White | Married, spouse present | Employed | Managers, all other | Scientific research and development services | Graduate degree | Full-time | 90000 | 1 |
| 30 | Male | Multiracial | Married, spouse present | Employed | Bus and truck mechanics and diesel engine specialists | Commercial and industrial machinery and equipment repair and maintenance | Some college | Full-time | 42000 | 1 |
| 22 | Male | Asian | Single | Unemployed | Packers and packagers, hand | Supermarkets and other grocery (except convenience) stores | Some college | Not working | 0 | 1 |
| 66 | Female | White | Married, spouse present | Employed | Paralegals and legal assistants | Legal services | Associate degree | Full-time | 40000 | 1 |
| 45 | Male | 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 | Part-time | 16000 | 1 |
| 23 | Male | White | Single | Employed | Packaging and filling machine operators and tenders | Sugar and confectionery products | Some college | Full-time | 30000 | 1 |
| 27 | Male | White | Single | Employed | Crane and tower operators | Truck transportation | Graduate degree | Full-time | 80000 | 1 |
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
Phân tích cho thấy có 65,820 dòng dữ liệu bị trùng lặp hoàn toàn. Để hiểu sâu hơn, chúng tôi đã thống kê tần suất xuất hiện của từng bộ đặc điểm duy nhất. Kết quả cho thấy một số bộ đặc điểm có thể lặp lại tới 16 lần. Trong bối cảnh dữ liệu điều tra nhân khẩu học, hiện tượng này có thể phản ánh các cá nhân hoặc hộ gia đình có cùng một tập hợp đặc điểm (ví dụ: độ tuổi, giới tính, khu vực sinh sống, thu nhập,…). Do đó, nhóm quyết định giữ nguyên các dòng trùng lặp vì chúng được coi là một đặc tính của mẫu điều tra, không phải là lỗi nhập liệu..
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
Hàm summary() cung cấp một cái nhìn tổng quan về phân phối của từng biến. Đối với các biến định lượng như age và incwage, nó cung cấp các giá trị min, max, trung bình, trung vị và các tứ phân vị. Đối với các biến định tính, nó liệt kê tần số của các cấp độ phổ biến nhất. Kết quả sơ bộ cho thấy incwage có độ lệch rất lớn (giá trị trung bình cao hơn nhiều so với trung vị), một đặc điểm cần được lưu ý trong các phân tích sau.
plot_intro(df, title = "Tổng quan cấu trúc dữ liệu")
plot_missing(df, title = "Tỷ lệ giá trị thiếu của từng biến")
update_geom_defaults("bar", list(orientation = "y"))
plot_bar(df, title = "Phân bố tần suất của các biến định tính")
plot_histogram(df, title = "Phân bố của các biến định lượng")
Để có một cái nhìn trực quan và nhanh chóng về dữ liệu, chúng tôi đã sử
dụng các hàm từ gói DataExplorer. plot_intro() cung cấp một “báo cáo sức
khỏe” tổng thể. plot_missing() xác nhận lại việc không có dữ liệu thiếu.
plot_bar() cho thấy sự phân bổ của các biến định tính, trong khi
plot_histogram() minh họa phân phối của các biến định lượng. Đáng chú ý,
biểu đồ histogram của incwage một lần nữa xác nhận sự phân phối lệch
phải mạnh, củng cố sự cần thiết của các phép biến đổi dữ liệu.
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ý 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 %>%
mutate(incwage = as.numeric(incwage)) %>%
filter(!is.na(incwage) & incwage >= 0 & incwage < 500000)
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 | 11757 |
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") ~ "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 | 45010 |
| Không xác định | 29483 |
df <- df %>%
mutate(Trình_độ_học_vấn = case_when(
educ %in% c("Less than high school", "Elementary school") ~ "Thấp",
educ %in% c("High school graduate", "Some college") ~ "Trung bình",
educ %in% c("Associate degree", "Bachelor's 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 | 51822 |
| Cao | 48823 |
| NA | 15217 |
df <- df %>%
mutate(
Tình_trạng_hôn_nhân = case_when(
marst %in% c("Married, spouse present", "Married, spouse absent") ~ "Đã kết hôn",
marst %in% c("Single", "Never married") ~ "Độc thân",
# Gộp các trạng thái khác (Divorced, Separated, Widowed, Unknown, NA...) vào "Khac"
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"))
# In tần số
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 |
|---|---|
| Độc thân | 66164 |
| Khác | 19593 |
| NA | 59916 |
df <- df %>%
mutate(
Chủng_tộc = case_when(
race %in% c("White", "white", "WHITE") ~ "Da trắng",
race %in% c("Black", "black", "BLACK") ~ "Da đen",
race %in% c("Asian", "asian", "ASIAN") ~ "Châu Á",
# Gộp các nhóm còn lại (American Indian, Pacific Islander, Multiracial, NA, v.v.) thành "Other"
TRUE ~ "Khác"
)
)
# Ép thành factor với thứ tự (tùy bạn)
df$Chủng_tộc <- factor(df$Chủng_tộc, levels = c("Da trắng", "Da đen", "Châu Á", "Khác"))
# In tần số
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 |
| Khác | 6558 |
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 |
Quá trình xử lý dữ liệu bắt đầu bằng việc loại bỏ các giá trị thu nhập ngoại lai (trên 500,000 USD/năm) để tăng độ tin cậy của phân tích. Tiếp theo, các biến liên tục và biến định tính chi tiết đã được mã hóa thành các nhóm có ý nghĩa hơn: incwage được phân thành 4 nhóm thu nhập; empstat được gán nhãn tiếng Việt rõ ràng; educ được nhóm thành 3 cấp độ học vấn “Thấp-Trung bình-Cao”; và age được chia thành 4 nhóm tuổi theo các giai đoạn sự nghiệp. Việc sắp xếp thứ tự cho các biến factor mới tạo (income_group, emp_status, educ_group, age_group) đảm bảo rằng các biểu đồ và bảng phân tích sẽ được trình bày một cách logic. Cuối cùng, các kết quả tính toán trước như thu nhập trung bình theo giới tính, nhóm tuổi và tình trạng việc làm đã được tính toán và lưu vào các bảng riêng (table1, table2, table3) để tối ưu hóa việc sử dụng lại trong các phần sau.
df <- df %>%
mutate(
fulltime_bin = ifelse(fullpart == "Full-time", 1,
ifelse(fullpart == "Part-time", 0, NA))
)
#Kiểm tra sau khi tạo
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 |
df <- df %>%
mutate(
sex_emp_interact = paste(sex, empstat, sep = "_")
)
# Kiểm tra vài dòng đầu
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 |
# Tính IQR và ngưỡng ngoài
Q1 <- quantile(df$incwage, 0.25, na.rm = TRUE)
Q3 <- quantile(df$incwage, 0.75, na.rm = TRUE)
IQR_val <- IQR(df$incwage, na.rm = TRUE)
# Lọc hoặc gán NA cho outlier
df <- df %>%
mutate(
incwage = ifelse(
incwage < (Q1 - 1.5 * IQR_val) | incwage > (Q3 + 1.5 * IQR_val),
NA, incwage
)
)
# Kiểm tra kết quả sau khi xử lý outlier
summary(df$incwage)
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
0 0 0 19883 37000 112500 8489