Môn Xử lý số liệu (XLSL) luôn là thử thách đối với nhiều bạn khi bắt đầu làm quen với ngôn ngữ lập trình R và Quarto. Để giúp các bạn ôn tập hiệu quả, mình xin chia sẻ bộ đáp án chi tiết cho Bài tập thực hành số 3.
Chi tiết đáp án bài thực hành
Lưu ý!Các đáp án và hướng dẫn thực hành được chia sẻ trong bài viết này chỉ mang tính chất tham khảo, hỗ trợ học tập và nghiên cứu. Wiky không chịu trách nhiệm về bất kỳ sai sót, cách hiểu hoặc việc sử dụng nội dung này cho mục đích khác ngoài học tập. Người đọc cần tự đánh giá, kiểm chứng và chịu trách nhiệm với kết quả khi áp dụng.
File đề thực hành:
---
title: "Tên tiêu đề"
author: "www.wiky.io.vn"
format: html
date: today
editor: visual
---
## **Bài 1**
### **Câu 1.1: Khám phá & kiểm tra cấu trúc dữ liệu**
```{r}
library(tibble)
library(skimr)
# Tạo dữ liệu df_22
df_22 <- tibble(
id = 1:100,
age = sample(c(18:85, NA), 100, replace = TRUE, prob = c(rep(1, 68), 8)),
gender = sample(c("Male","Female", NA), 100, replace = TRUE, prob = c(.46,.49,.05)),
height = round(rnorm(100, 165, 8), 1),
weight = round(rnorm(100, 62, 12), 1),
sbp = round(rnorm(100, 120, 18), 0),
visit_date = as.Date("2025-01-01") + sample(0:365, 100, TRUE)
)
```
#### *1. Dùng các hàm `head()`, `str()`, `glimpse()`, `dim()` để mô tả dữ liệu*
```{r}
# Xem các dòng đầu tiên
head(df_22)
# Xem cấu trúc chi tiết của dữ liệu
str(df_22)
# Xem cấu trúc chi tiết của dữ liệu (nhưng gọn hơn)
glimpse(df_22)
# In số hàng và số cột của dữ liệu
dim(df_22)
```
#### *2. Dùm hàm `skim()` để tóm tắt nhanh*
```{r}
# Tổng quan dữ liệu
skim(df_22)
```
#### *3. Tính tỉ lệ thiếu*
```{r}
#| warning: false
library(naniar)
# Cách 1: Biểu đồ tỷ lệ missing theo từng biến
gg_miss_var(df_22)
# Cách 2: Xem danh sách dạng bảng
miss_var_summary(df_22)
```
### **Câu 1.2: Kiểm tra tính nhất quán & hợp lệ**
```{r}
library(tibble)
# Tạo dữ liệu df_23
df_23 <- tibble(
pid = sprintf("BN%03d", 1:100),
age = sample(c(5:95, -3, 180), 100, replace = TRUE, prob = c(rep(1, 91), 3, 6)),
spo2 = sample(c(80:100, 55, 130), 100, replace = TRUE, prob = c(rep(1, 21), 2, 1)),
height_cm = sample(c(130:195, 20, 350), 100, replace = TRUE, prob = c(rep(1, 66), 2, 1)),
weight_kg = sample(c(35:110, 5, 250), 100, replace = TRUE, prob = c(rep(1, 76), 2, 1))
)
# Xem 5 dòng đầu tiên
head(df_23, 5)
```
#### *1. Tạo cờ hợp lệ cho từng biến*
```{r}
#| warning: false
library(dplyr)
df_valid <- df_23 |>
mutate(
valid_age = age > 0 & age < 120,
valid_spo2 = spo2 >= 50 & spo2 <= 100,
valid_height = height_cm >= 100 & height_cm <= 220,
valid_weight = weight_kg >= 25 & weight_kg <= 200
)
# Xem 5 dòng đầu tiên
head(df_valid, 5)
```
#### *2. Tính số lỗi theo loại*
```{r}
summary_flags <- df_valid |>
transmute(
invalid_age = !valid_age,
invalid_spo2 = !valid_spo2,
invalid_weight = !valid_weight,
invalid_height = !valid_height
) |>
summarise(across(everything(), sum))
# Xem bảng in
summary_flags
```
#### *3. Tạo bảng mới gồm các dòng có ít nhất 1 lỗi và sắp theo mức độ*
```{r}
df_23_invalid <- df_valid |>
# Lỗi xảy ra khi cờ hợp lệ bằng FALSE (hoặc !valid)
mutate(
total_errors = (!valid_age) + (!valid_spo2) + (!valid_height) + (!valid_weight)
) |>
# Lọc ra các dòng có ít nhất 1 lỗi
filter(total_errors >= 1) |>
# Sắp xếp theo mức độ lỗi giảm dần
arrange(desc(total_errors))
# Xem 5 dòng đầu tiên
head(df_23_invalid, 5)
```
### **Câu 1.3: Xử lý dữ liệu thiếu**
```{r}
library(tibble)
# Tạo dữ liệu df_24
df_24 <- tibble(
id = 1:100,
age = sample(18:80, 100, TRUE),
gender = sample(c("Male","Female"), 100, TRUE),
income = round(rlnorm(100, log(8e6), 0.6)),
smoker = rbinom(100, 1, 0.25)
) |>
mutate(
income = ifelse(smoker == 1 & runif(100) < 0.25, NA, income)
)
# Xem 5 dòng đầu tiên
head(df_24, 5)
```
#### *1. Trực quan missing bằng `naniar::vis_miss()`*
```{r}
naniar::vis_miss(df_24)
```
#### *2. So sánh 2 cách*
```{r}
library(tidyr)
library(naniar)
# Cách 1: Xóa các dòng chứa NA ở cột income
df_drop <- df_24 |> drop_na(income)
# In kết quả cách 1
df_drop
# Cách 2: Điền khuyết NA bằng giá trị trung vị
df_imp_median <- df_24 |> mutate(income = ifelse(is.na(income), median(income, na.rm=TRUE), income))
# In kết quả cách 2
df_imp_median
```
#### *3. So sánh Mean/Median income trước – sau theo từng cách, và nhận xét*
Tính toán Mean và Median của cột `income` cho cả 3 trường hợp:
```{r}
library(tibble)
# Tính toán và tạo bảng so sánh
bang_so_sanh <- tibble(
Phuong_Phap = c(
"Dữ liệu gốc",
"Drop NA",
"Impute Median"
),
Mean_Income = c(
mean(df_24$income, na.rm = TRUE),
mean(df_drop$income),
mean(df_imp_median$income)
),
Median_Income = c(
median(df_24$income, na.rm = TRUE),
median(df_drop$income),
median(df_imp_median$income)
)
)
# Hiển thị bảng
knitr::kable(bang_so_sanh, format.args = list(big.mark = ","))
```
**Nhận xét định tính về độ "lệch" của dữ liệu:**
- **Drop NA:** Giá trị Mean và Median không thay đổi so với khi tính trên dữ liệu gốc. Phương pháp này giữ nguyên được hình dáng phân phối tự nhiên của tập dữ liệu, nhưng làm mất đi số lượng quan sátsát-
- **Impute Median:** Giá trị Median không đổi, nhưng Mean bị giảm xuống và tiến gần hơn về phía Median.
- **Kết luận:** Cách 1 không gây ảnh hưởng đến các giá trị Mean và Median khi sử dụng. Cách 2 làm dữ liệu bị lệch. Tuy nhiên, ở cách 1 là làm giảm đi cỡ mẫu ban đầu nên có thể làm mất đi tính đại diện của tập dữ liệu. Do đó tùy thuộc vào tỷ lệ thiếu dữ liệu thể hiện ở hàm `vis_miss()`, ta nên chọn phương pháp nào phù hợp.
## **Bài 2**
### **Câu 2.1: Xử lý ngoại lai**
```{r}
library(tibble)
set.seed(123)
# Tạo dữ liệu df_25
x <- c(rnorm(97, 50, 8), 120, 130, 5)
df_25 <- tibble(id = 1:100, biomarker = round(sample(x, 100), 1))
# Xem 5 dòng đầu tiên
head(df_25, 5)
```
#### *1. Viết hàm `flag_iqr(x)` trả về TRUE/FALSE nếu là outlier*
```{r}
# Quy tắc: x < Q1 - 1.5*IQR hoặc x > Q3 + 1.5*IQR
flag_iqr <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR_val
upper_bound <- Q3 + 1.5 * IQR_val
# Trả về vector TRUE/FALSE
return(x < lower_bound | x > upper_bound)
}
```
#### *2. Tạo cột `is_outlier` và liệt kê các id outlier*
```{r}
df_25 <- df_25 %>%
mutate(is_outlier = flag_iqr(biomarker))
# Liệt kê các quan sát là ngoại lai
outliers_list <- df_25 %>%
filter(is_outlier == TRUE)
print(outliers_list)
```
#### *3. Vẽ biểu đồ*
```{r}
# 3.1 Vẽ boxplot cho biomarker
boxplot(df_25$biomarker,
main = "Boxplot phát hiện outlier",
ylab = "Giá trị biomarker",
col = "lightblue",
horizontal = FALSE)
# 3.2 Vẽ scatter plot và tô màu theo is_outlier
plot(df_25$id, df_25$biomarker,
pch = 16,
col = ifelse(df_25$is_outlier, "red", "black"),
xlab = "Chỉ số quan sát",
ylab = "Giá trị biomarker",
main = "Scatter plot phát hiện outlier")
legend("topleft",
legend = c("Bình thường", "Outlier"),
col = c("black", "red"),
pch = 16)
```
### **Câu 2.2: Chuẩn hóa & biến đổi dữ liệu**
```{r}
library(tibble)
# Tạo dữ liệu df_26
set.seed(123)
df_26 <- tibble(
id = 1:100,
age = sample(18:80, 100, TRUE),
crp = round(rlnorm(100, log(3), 0.9), 2),
steps = round(rnorm(100, 6500, 2200), 0)
)
# Xem 5 dòng đầu tiên
head(df_26, 5)
```
#### *1. Viết công thức chuẩn hóa*
```{r}
# Tạo hàm Min-Max
scale_minmax <- function(x) {
(x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
}
# Tạo hàm Z-score
scale_zscore <- function(x) {
(x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}
# Tạo hàm Robust Scaling
scale_robust <- function(x) {
(x - median(x, na.rm = TRUE)) / IQR(x, na.rm = TRUE)
}
```
#### *2 và 3. Áp dụng scaling, tạo biến mới và biến đổi phân phối*
```{r}
df_26_transformed <- df_26 %>%
mutate(
# 2. Áp dụng các hàm chuẩn hóa
age_z = scale_zscore(age),
steps_mm = scale_minmax(steps),
steps_rob = scale_robust(steps),
# 3. Biến đổi phân phối logarit cho crp
crp_log = log(crp)
)
# Kiểm tra kết quả sau khi biến đổi
head(df_26_transformed %>% select(id, age_z, steps_mm, steps_rob, crp, crp_log))
```
### **Câu 2.3: Xử lý biến phân loại & encoding**
```{r}
library(tibble)
# Tạo dữ liệu df_27
set.seed(123)
df_27 <- tibble(
id = 1:100,
city = sample(c("CT", "HCM", "HN", "DN"), 100, TRUE),
severity = factor(sample(c("Mild", "Moderate", "Severe"), 100, TRUE),
levels = c("Mild", "Moderate", "Severe"), ordered = TRUE), # ordinal
outcome = rbinom(100, 1, 0.35)
)
# Xem 5 dòng đầu tiên
head(df_27, 5)
```
#### *1. One-hot encoding `city` và ghép với dữ liệu gốc*
```{r}
# Tạo ma trận one-hot encoding
city_onehot <- model.matrix(~ city - 1, data = df_27)
# Ghép ma trận vừa tạo vào tập dữ liệu gốc
df_27_encoded <- cbind(df_27, city_onehot) %>% as_tibble()
```
#### *2. Ordinal encoding `severity`*
```{r}
# Ép kiểu sang integer để lấy giá trị số tương ứng với thứ tự levels
df_27_encoded <- df_27_encoded %>%
mutate(severity_code = as.integer(severity))
# Xem 5 dòng đầu tiên
head(df_27_encoded, 5)
```
## **Bài 3**
```{r}
#| warning: false
library(tibble)
library(dplyr)
library(skimr)
library(naniar)
library(mice)
library(stringr)
library(tidyr)
set.seed(12345)
# Tạo dữ liệu df_29
df_29 <- tibble(
patient_code = sprintf("%s-%04d-%s",
sample(c("CT","HCM","HN","DN"), 100, TRUE),
sample(2018:2025, 100, TRUE),
sample(c("A","B","C"), 100, TRUE)),
age = sample(c(18:85, -2, 150, NA), 100, TRUE, prob=c(rep(1,68), 2, 2, 8)),
gender = sample(c("Male","Female", NA), 100, TRUE, prob=c(.46,.49,.05)),
height_cm = round(rnorm(100, 165, 8), 1),
weight_kg = round(rnorm(100, 62, 12), 1),
income = round(rlnorm(100, log(9e6), 0.8)),
smoker = sample(c(0,1,NA), 100, TRUE, prob=c(.70,.25,.05)),
note = sample(c("cough 2w", "no cough", "fever 3d", "smoker", "unknown"), 100, TRUE),
outcome = rbinom(100, 1, 0.30)
) %>%
mutate(
# Cài 2 outlier
income = replace(income, sample(1:100, 2), c(2e8, 3e8)),
# Missing income phụ thuộc smoker (MAR thô)
income = ifelse(smoker == 1 & runif(100) < 0.20, NA, income)
)
```
### **A. Inspection và Validity**
#### *1. Báo cáo nhanh dữ liệu*
```{r}
# In số hàng và số cột của dữ liệu
dim(df_29)
# Xem cấu trúc chi tiết của dữ liệu
str(df_29)
# Tổng quan dữ liệu
skim(df_29)
# Liệt kê đếm số lượng biến bị missing
colSums(is.na(df_29))
```
#### *2. Tạo cờ hợp lệ và bảng `df_invalid`*
```{r}
df_valid <- df_29 %>%
mutate(
valid_age = age >= 0 & age <= 120,
valid_height_cm = height_cm >= 120 & height_cm <= 210,
valid_weight_kg = weight_kg >= 25 & weight_kg <= 200
)
# Tạo bảng chứa các dòng vi phạm ít nhất 1 quy tắc
df_invalid <- df_valid %>%
filter(!(valid_age & valid_height_cm & valid_weight_kg))
# Đếm số quan sát có lỗi theo từng loại
summary_errors <- df_valid %>%
summarise(
err_age = sum(!valid_age, na.rm = TRUE),
err_height = sum(!valid_height_cm, na.rm = TRUE),
err_weight = sum(!valid_weight_kg, na.rm = TRUE)
)
# In bảng kết quả
print(summary_errors)
```
### **B. Missing**
#### *3. Trực quan missing bằng `vis_miss()`*
```{r}
# Vẽ biểu đồ nhiệt thể hiện tỷ lệ dữ liệu thiếu
vis_miss(df_29)
```
#### *4. Thực hiện Multiple Imputation cho income và smoker*
```{r}
#| warning: false
# Tạo ma trận dự đoán loại bỏ đa cộng tuyến
pred_matrix <- quickpred(df_29)
# Chạy lại mice với ma trận dự đoán vừa tạo
imp <- mice(df_29, m = 5, method = "pmm", seed = 123,
pred = pred_matrix, printFlag = FALSE)
# Lấy ra bộ dữ liệu thứ 1 sau khi impute
df_imp <- complete(imp, 1)
# (Tùy chọn) Fit mô hình GLM trên từng bộ MI và Pool kết quả
fit_mi <- with(imp, glm(outcome ~ age + gender + income + smoker, family = binomial))
# Kết hợp kết quả theo Rubin's rules
pooled_results <- pool(fit_mi)
summary(pooled_results, conf.int = TRUE)
```
### **C. Outlier và Scaling/Transform**
#### *5. Flag outlier của income theo IQR trên tập dữ liệu đã impute*
```{r}
Q1_inc <- quantile(df_imp$income, 0.25, na.rm = TRUE)
Q3_inc <- quantile(df_imp$income, 0.75, na.rm = TRUE)
IQR_inc <- Q3_inc - Q1_inc
df_imp <- df_imp %>%
mutate(
is_outlier_income = income < (Q1_inc - 1.5 * IQR_inc) | income > (Q3_inc + 1.5 * IQR_inc)
)
```
#### *6. Chuẩn hóa các biến số (sử dụng Z-score Scaling thông qua hàm scale)*
```{r}
df_imp <- df_imp %>%
mutate(
age_z = as.numeric(scale(age)),
height_z = as.numeric(scale(height_cm)),
weight_z = as.numeric(scale(weight_kg)),
income_z = as.numeric(scale(income))
)
```
### **D. Encoding**
#### *7. Encode `gender` (Nominal) thành factor chuẩn*
```{r}
df_imp <- df_imp %>%
mutate(gender = factor(gender, levels = c("Male", "Female")))
```
#### *8. Tạo biến ordinal `edu_levlevel` và encode ordinal*
```{r}
df_imp <- df_imp %>%
mutate(
# Giả lập biến trình độ học vấn có thứ tự
edu_level = factor(sample(c("Low", "Medium", "High"), 100, replace = TRUE),
levels = c("Low", "Medium", "High"),
ordered = TRUE),
# Ordinal Encoding thành 1-2-3
edu_code = as.integer(edu_level)
)
```
### **E. Feature engineering**
#### *9. Tạo các biến mới theo công thức*
```{r}
df_imp <- df_imp %>%
mutate(
# Tính BMI
bmi = weight_kg / (height_cm / 100)^2,
# Phân nhóm biến liên tục thành categorical
age_group = case_when(
age < 40 ~ "<40",
age >= 40 & age <= 59 ~ "40-59",
age >= 60 ~ ">=60"
),
# Tạo chỉ số rủi ro
risk_index = 0.03 * age + 0.8 * (smoker == 1) + 0.05 * bmi
)
```
#### *10. Trích xuất thông tin từ chuỗi `patient_code`*
```{r}
df_imp <- df_imp %>%
separate(col = patient_code,
into = c("city_code", "year", "group"),
sep = "-",
remove = FALSE)
# In kết quả cuối
head(df_imp %>% select(patient_code, city_code, year, group, bmi, age_group, risk_index))
```
Lời kết
Hy vọng bài viết này giúp ích cho lộ trình học tập của bạn. Nếu thấy hữu ích, đừng ngần ngại chia sẻ bài viết này cho các bạn cùng lớp nhé! Mọi câu hỏi góp ý xin vui lòng để lại phía dưới phần bình luận. Chúc các bạn làm bài thực hành thật tốt!
Copyright (c):
www.wiky.io.vn
