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ố 4.
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
---
## **1. DỮ LIỆU GIẢ LẬP**
```{r}
#| warning: false
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
janitor, # data cleaning and tables
lubridate, # working with dates
epikit, # age_categories() function
dplyr, tidyr, # Bien tap du lieu
readxl, # Doc file excel xlsx
skimr, # Danh gia du lieu
stringr,
mice, # MI Dữ liệu missing
naniar, # đánh giá và trực quan hóa missing
DT , # Tao bang hien thi R quarto
tidyverse, # ggplot2 + dplyr + tidyr + forcats + lubridate
scales, # định dạng trục: phần trăm, dấu phẩy, log
patchwork, # ghép nhiều biểu đồ ggplot
ggpubr, # biểu đồ "sẵn sàng xuất bản" + chú thích thống kê
GGally, # ma trận biểu đồ cặp (ggpairs)
ggridges, # biểu đồ ridgeline (so sánh nhiều phân phối)
hexbin, # biểu đồ hexbin (xử lý chồng điểm)
viridis,
)
set.seed(12345)
n <- 300
df <- data.frame(
id = 1:n,
age = sample(c(18:80, NA), n, replace = TRUE),
gender = sample(c("Male", "Female"), n, replace = TRUE),
bmi = round(rnorm(n, 23, 3), 1),
income = round(rlnorm(n, log(8), 0.5), 1),
smoker = sample(c(0, 1, NA), n, replace = TRUE, prob = c(0.6, 0.3, 0.1)),
education = sample(c("High school", "College", "University", NA), n, replace = TRUE),
severity = sample(c("Mild", "Moderate", "Severe"), n, replace = TRUE),
systolic_bp = round(rnorm(n, 120, 15), 0)
)
str(df)
head(df)
```
## **2. PHẦN A – THỐNG KÊ MÔ TẢ**
### Câu 2.1
```{r}
#| warning: false
# Tính trung bình và độ lệch chuẩn (Loại NA khi tính)
df |>
summarise(
across(
.cols = c(age, bmi, systolic_bp),
.fns = list(
mean = ~ round(mean(.x, na.rm = TRUE), 2),
sd = ~ round(sd(.x, na.rm = TRUE), 2)))
)
colSums(is.na(df))
df_tyle_na <- df |>
summarise(across(everything(), \(x) mean(is.na(x)) * 100))
df_tyle_na
# Tính tỷ lệ missing theo biến và sắp thứ tự
sort(round(colMeans(is.na(df)),3), decreasing = TRUE)
```
**Nhận xét:**
- Biến có tỷ lệ thiếu dữ liệu cao nhất là `education` với khoảng **21.7%**.
- Mức huyết áp tâm thu trung bình của toàn mẫu là **120.09 mmHg**. Chỉ số huyết áp này hoàn toàn nằm trong giới hạn bình thường và là mức lý tưởng đối với sức khỏe tim mạch của người trưởng thành.
### Câu 2.2
```{r}
#| warning: false
# Tạo bảng tần số và tỷ lệ
tabyl(df, gender)
tabyl(df, smoker)
tabyl(df, severity)
# Tính tỷ lệ tích lũy cho biến thứ bậc severity
df |>
count(severity, .drop = FALSE) |>
mutate(
percent = n / sum(n),
cum_percent = cumsum(percent)*100
)
```
**Nhận xét:**
- Dựa vào bảng tần số, nhóm mức độ bệnh chiếm tỷ lệ cao nhất là `Mild` với **40%**.
- Tỷ lệ người hút thuốc trong tập dữ liệu chiếm khoảng **29%** trên tổng thể (hoặc **31.5%** nếu loại bỏ các giá trị NA). Với tỷ lệ trên 20%, thói quen hút thuốc trong mẫu khảo sát này ở mức khá cao và có thể coi là một yếu tố nguy cơ đáng lo ngại cho tiến triển bệnh lý.
### Câu 2.3
```{r}
# Tính các đại lượng thống kê cho biến income
df %>%
summarize(
n = n(),
income_mean = mean(income, na.rm = TRUE),
income_med = median(income, na.rm = TRUE),
income_max = max(income, na.rm = TRUE),
income_min = min(income, na.rm = TRUE),
income_iqr = IQR(income, na.rm = TRUE),
)
```
**Nhận xét:**
- Phân bố thu nhập của mẫu bị lệch phải rõ rệt do giá trị trung bình lớn hơn giá trị trung vị (**9.34 \> 8.3**). Sự chênh lệch này xuất phát từ việc có những cá nhân có thu nhập ngoại lai cực kỳ cao (giá trị Max lên đến **37.6**) làm kéo giá trị trung bình tăng lên.
- Do dữ liệu bị lệch và có chứa ngoại lai, ta nên sử dụng trung vị để đại diện cho mức thu nhập vì đại lượng này phản ánh đúng thực tế số đông hơn.
### Bài 2.4
```{r}
# Tính trung bình bmi theo giới tính
df |>
group_by(gender) |>
summarise(
gender_bmi_tb = median(bmi, na.rm = TRUE)
)
# Tính trung bình bmi theo tình trạng hút thuốc
df |>
group_by(smoker) |>
summarise(
smoker_bmi_tb = median(bmi, na.rm = TRUE)
)
# Lập bảng chéo giữa gender và smoker
bangcheo_1 = table(df$gender, df$smoker)
bangcheo_1
# Lập bảng chéo giữa severity và smoker
bangcheo_2 = table(df$severity, df$smoker)
bangcheo_2
```
**Nhận xét:**
- Không có sự chênh lệch lớn về chỉ số BMI giữa hai giới, với trung vị của Nam (**23.7**) chỉ nhỉnh hơn một chút so với nữ (**23.1**).
- Về mối liên hệ với mức độ bệnh, tỷ lệ người hút thuốc trong nhóm bệnh `Moderate` cao nhất, xấp xỉ **39.2%**. Mặc dù tỷ lệ này giảm ở nhóm `Severe`, nhưng nhìn chung tỷ lệ hút thuốc ở các nhóm bệnh từ trung bình đến nặng vẫn giữ ở mức cao, cho thấy thói quen này có thể liên quan đến tình trạng bệnh.
### Bài 2.5:
```{r}
# Phân nhóm tuổi
df_nhomtuoi <- df |>
filter(!is.na(age)) |>
mutate(
nhom_tuoi = case_when(
age>0 & age < 30 ~ "contre",
age >= 30 & age <= 50 ~ "trungnien",
age > 50 ~ "caotuoi"
),
nhom_tuoi = factor(nhom_tuoi, levels = c("contre", "trungnien", "caotuoi"))
) |>
# Tính toán theo nhóm tuổi
group_by(nhom_tuoi) |>
summarise(
tb_huyet_ap = round(mean(systolic_bp, na.rm = TRUE),3),
ty_le_smoke = round(mean(smoker == 1, na.rm = TRUE) * 100,3)
)
df_nhomtuoi
```
**Nhận xét:**
- Huyết áp không có xu hướng tăng tuyến tính theo nhóm tuổi, cụ thể nhóm `trungnien` có huyết áp trung bình cao nhất (**123 mmHg**), cao hơn cả nhóm `caotuoi` (**119 mmHg**).
- Nhóm có độ tuổi trẻ nhất `contre` lại có tỷ lệ hút thuốc cao nhất trong mẫu với **43.5%**.
- Tỷ lệ hút thuốc rất cao ở người trẻ này chính là một yếu tố nguy cơ tiềm ẩn cực kỳ nghiêm trọng, có thể dẫn đến các hệ lụy về mạch máu và huyết áp trong tương lai.
## **3. PHẦN B – TRỰC QUAN HÓA DỮ LIỆU**
### Câu 3.1
```{r}
#| warning: false
# Đồ thị Histogram của age
ggplot(df, aes(x = age)) +
geom_histogram(binwidth = 1, fill = "dodgerblue", colour = "gainsboro") +
labs(x = "Độ tuổi", y = "Số bệnh nhân", title = "Phân phối Tuổi của các bệnh nhân")
# Đồ thị Histogram của income
ggplot(df, aes(x = income)) +
geom_histogram(binwidth = 1, fill = "dodgerblue", colour = "gainsboro") +
labs(x = "Thu nhập", y = "Số bệnh nhân", title = "Phân phối Thu nhập của các bệnh nhân")
```
**Nhận xét:**
- Phân bố tuổi trong mẫu không tuân theo quy luật phân phối chuẩn, vì biểu đồ không có đỉnh nhô cao ở trung tâm và hai đuôi thoai ra. Thay vào đó, tần số của các bệnh nhân trải khá đều và nhấp nhô trên toàn bộ trục ngang từ 20 đến 80 tuổi, mang đặc điểm của một phân phối đều.
- Phân bố thu nhập thể hiện rất rõ hình dáng lệch phải, với các dữ liệu tập trung ở mức thu nhập thấp (từ 5 đến 10 triệu). Và tần số giảm mạnh dần về phía các mức thu nhập cao.
### Câu 3.2
```{r}
#| warning: false
# Biểu đồ cột cho severity
df |>
filter(!is.na(severity)) |>
mutate(severity = factor(severity, levels = c("Moderate", "Severe", "Mild"), ordered = TRUE)) |>
ggplot(aes(x = severity)) +
geom_bar(fill = "dodgerblue") +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.3) +
labs(title = "Biểu đồ mức độ bệnh", x = "Mức độ bệnh", y = "Số bệnh nhân") +
theme_minimal()
# Biểu đồ cột cho education
df |>
filter(!is.na(education)) |>
mutate(education = factor(education, levels = c("University", "High school", "College"), ordered = TRUE)) |>
ggplot(aes(x = education)) +
geom_bar(fill = "forestgreen") +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.3) +
labs(title = "Biểu đồ trình độ học vấn", x = "Trình độ học vấn", y = "Số bệnh nhân") +
theme_minimal()
# Biểu đồ cột và phần trăm cho severity
df |>
filter(!is.na(severity)) |>
count(severity) |>
mutate(pct = n / sum(n)) |>
ggplot(aes(x = fct_reorder(severity, pct), y = pct)) +
geom_col(fill = "lightseagreen") +
geom_text(aes(label = percent(pct, accuracy = 0.1)), vjust = -0.3) +
scale_y_continuous(labels = percent_format()) +
labs(title = "Biểu đồ phân bố mức độ bệnh", x = "Mức độ bệnh", y = "Tỷ lệ")
# Biểu đồ cột và phần trăm cho education
df |>
filter(!is.na(education)) |>
count(education) |>
mutate(pct = n / sum(n)) |>
ggplot(aes(x = fct_reorder(education, pct), y = pct)) +
geom_col(fill = "limegreen") +
geom_text(aes(label = percent(pct, accuracy = 0.1)), vjust = -0.3) +
scale_y_continuous(labels = percent_format()) +
labs(title = "Biểu đồ tỷ lệ trình độ học vấn",x = "Trình độ học vấn", y = "Tỷ lệ")
```
**Nhận xét:**
Dựa trên giá trị của biểu đồ, trình độ học vấn phổ biến nhất trong mẫu là `College` với 82 bệnh nhân chiếm tỷ lệ **34.9%**, tiếp theo là `High school` và `University`.
### Câu 3.3
```{r}
# Biểu đồ Boxplot bmi theo gender
ggplot(df, aes(x = gender, y = bmi, fill = gender)) +
geom_violin(alpha = 0.4, colour = NA) +
geom_boxplot(width = 0.18, outlier.size = 0.8) +
stat_summary(fun = mean, geom = "point",shape = 23, size = 2.5, fill = "white") +
scale_fill_viridis_d() +
labs(title = "Biểu đồ BMI theo giới tính", x = "Giới tính", y = "BMI") +
theme(legend.position = "none")
# Biểu đồ Boxplot systolic_bp theo smoker
df |>
filter(!is.na(smoker), !is.na(systolic_bp)) |>
ggplot(aes(x = factor(smoker), y = systolic_bp, fill = factor(smoker))) +
geom_violin(alpha = 0.4, colour = NA) +
geom_boxplot(width = 0.18, outlier.size = 0.8) +
stat_summary(fun = mean, geom = "point", shape = 23, size = 2.5, fill = "white") +
scale_fill_viridis_d() +
scale_x_discrete(labels = c("0" = "Không hút", "1" = "Hút thuốc")) +
labs(title = "Biểu đồ huyết áp với tình trạng hút thuốc", x = "Tình trạng hút thuốc", y = "Huyết áp tâm thu") +
theme(legend.position = "none")
```
**Nhận xét:**
- Biểu đồ Boxplot ghi nhận sự xuất hiện của các giá trị ngoại lai (outliers) ở cả hai biến. Ở biểu đồ thể trạng, ghi nhận một cá nhân Nam giới có mức BMI rớt xuống cực thấp chỉ khoảng 15. Ở khía cạnh huyết áp, một cá nhân thuộc nhóm hút thuốc lại có chỉ số huyết áp tâm thu vọt lên mức vô cùng nguy hiểm, vượt ngưỡng 160 mmHg.
- Nhìn vào phần thân hộp, sự phân bố huyết áp trung vị của cả hai nhóm hút thuốc và không hút thuốc là ngang ngửa nhau (quanh mức 120 mmHg). Cấu trúc biểu đồ violin của hai nhóm cũng phình to ở cùng một vị trí, chứng tỏ thói quen hút thuốc chưa thể hiện sự làm tăng mức huyết áp trung bình của số đông trong mẫu này.
### Câu 3.4
```{r}
#| warning: false
# Vẽ biểu đồ scatter plot giữa age và systolic_bp
ggplot(df, aes(x = age, y = systolic_bp)) +
geom_point(alpha = 0.4, colour = "blue") +
geom_smooth(method = "lm", colour = "red", fill = "lightpink") +
labs(title = "Biểu đồ tán xạ giữa Tuổi và Huyết áp tâm thu", x = "Tuổi", y = "Huyết áp tâm thu (mmHg)")
```
**Nhận xét:**
- Đường hồi quy tuyến tính màu đỏ trên biểu đồ gần như chạy ngang hoàn toàn, song song với trục hoành, cho thấy không có xu hướng tuyến tính rõ rệt giữa hai biến số. Việc tuổi tác tăng lên không kéo theo một sự gia tăng huyết áp có thể dự báo được.
- Các điểm dữ liệu phân bố vô cùng rải rác và ngẫu nhiên trên một dải rất rộng, không bám sát hay tập trung dọc theo đường hồi quy. Do đó, mối liên hệ giữa sự gia tăng tuổi tác và mức huyết áp trong tập dữ liệu này là
### Câu 3.5
```{r}
#| warning: false
# a. Histogram của age
p1 <- ggplot(df, aes(x = age)) +
geom_histogram(fill = "dodgerblue",color = "gainsboro",bins = 15) +
labs(title = "a. Phân bố Tuổi", x = "Tuổi", y = "Tần số") +
theme_minimal() +
theme(legend.position = "none")
# b. Boxplot của bmi theo gender
p2 <- ggplot(df, aes(x = gender, y = bmi, fill = gender)) +
geom_violin(alpha = 0.4, colour = NA) +
geom_boxplot(width = 0.18, outlier.size = 0.8) +
stat_summary(fun = mean,geom = "point",shape = 23,size = 2.5,fill = "white") +
scale_fill_viridis_d() +
labs(title = "b. BMI theo Giới tính", x = "Giới tính", y = "BMI") +
theme(legend.position = "none")
# c. Biểu đồ cột của severity
# Sắp xếp lại thứ tự từ Mild -> Severe cho đúng logic
df$severity <- factor(df$severity, levels = c("Mild", "Moderate", "Severe"))
p3 <- ggplot(df, aes(x = severity, fill = severity)) +
geom_bar(alpha = 0.8) +
labs(title = "c. Mức độ Bệnh", x = "Mức độ", y = "Số bệnh nhân") +
theme_minimal() +
theme(legend.position = "none")
# d. Scatter plot giữa age và systolic_bp
p4 <- ggplot(df, aes(x = age, y = systolic_bp)) +
geom_point(color = "blue", alpha = 0.5) +
geom_smooth(method = "lm",color = "red", se = FALSE) +
labs(title = "d. Tuổi và Huyết áp tâm thu", x = "Tuổi", y = "Huyết áp tâm thu") +
theme_minimal() +
theme(legend.position = "none")
# Gộp 4 biểu đồ lại
tong_hop <- (p1 | p2) / (p3 | p4) +
plot_annotation(title = "TỔNG QUAN ĐẶC ĐIỂM DÂN SỐ NGHIÊN CỨU",theme = theme(plot.title = element_text(size = 16, face = "bold", hjust = 0.5)))
# Hiển thị kết quả
tong_hop
```
**Nhận xét:**
- Phân bố tuổi không có sự đối xứng, với tần số bệnh nhân khá dàn trải từ khoảng 20 đến 80 tuổi không có một đỉnh trung tâm nào.
- Sự khác biệt về chỉ số BMI giữa hai giới là không đáng kể. Đường trung vị và giá trị trung bình của cả hai nhóm đều nằm sát ranh giới 23 - 24. Cho thấy giới tính có sự đồng nhất về thể trạng cơ bản.
- Nhóm mức độ bệnh `Mild` chiếm tỷ trọng cao nhất với số lượng bệnh nhân vượt mốc 100 bệnh nhân.
- Không có xu hướng tuyến tính rõ rệt giữa độ tuổi và huyết áp tâm thu. Đường hồi quy màu đỏ gần như nằm ngang hoàn toàn. Sự phân tán của các điểm dữ liệu theo trục dọc dao động mạnh từ dưới 100 đến trên 150 mmHg ở bất kỳ độ tuổi.
- Đây là một quần thể bệnh nhân rất đa dạng về độ tuổi, có nền tảng thể trạng khỏe mạnh và đồng đều ở cả hai giới. Dù đa số bệnh nhân ở mức độ bệnh nhẹ, nhưng chỉ số huyết áp lại không bị chi phối bởi tuổi tác. Điều này cho thấy tình trạng bệnh lý hoặc huyết áp của quần thể này có thể đang bị chi phối bởi các yếu tố ngoại lai khác mạnh mẽ hơn (như gen, chế độ ăn, hoặc tình trạng hút thuốc).
### Bài 3.6
```{r}
#| warning: false
# Vẽ biểu đồ kết hợp
df_36 <- df |>
filter(!is.na(income), !is.na(education),!is.na(gender),!is.na(smoker)) |>
mutate( education = factor(education,levels = c("High school", "College", "University"), ordered = TRUE),
smoker_label = factor( smoker, levels = c(0, 1), labels =c("Non-smoker", "Smoker") )
)
ggplot(df_36, aes(x = education, y = income, fill = gender)) +
geom_boxplot(alpha = 0.8) +
facet_wrap( ~ smoker_label) +
scale_fill_manual(values = c("Female" = "#af56fc", "Male" = "#0fa0d7")) +
labs(title = "Phân bố Thu nhập theo Học vấn, Giới tính và Tình trạng Hút thuốc", x = "Trình độ học vấn", y = "Thu nhập", fill = "Giới tính") +
theme_bw() +
theme(
strip.background = element_rect(fill = "grey90"),
strip.text = element_text(face = "bold", size = 12)
)
```
**Nhận xét:**
- Mức thu nhập không có xu hướng tăng theo cấp bậc học vấn; trung vị thu nhập của nhóm `High school` dao động quanh mốc 8 - 10, gần như tương đương nhau.
- Sự chênh lệch thu nhập theo giới tính có tồn tại nhưng dao động không nhất quán tùy thuộc vào cấp học. Chẳng hạn, ở nhóm `Non-smoker`, Nam giới có thu nhập trung vị nhỉnh hơn Nữ ở bậc `High school` và `University`, nhưng lại thấp hơn Nữ ở bậc `College`.
- Mối liên hệ này có sự khác biệt rõ rệt về độ ổn định. Ở nhóm `Non-smoker`, phổ phân bố thu nhập khá đồng đều và ổn định qua cả 3 cấp học vấn. Ngược lại, ở nhóm `Smoker`, sự biến động diễn ra cực kỳ mạnh; rõ rệt nhất là sự sụt giảm thu nhập trung vị nghiêm trọng ở nhóm `College`, phá vỡ cấu trúc phân bố tương đối ở nhóm `Non-smoker`.
- Biến số hút thuốc đóng vai trò như một yếu tố nhiễu làm thay đổi đáng kể cục diện phân bố. Khi đưa vào, nó kéo tụt hẳn mức thu nhập của nhóm `College` (đặc biệt là đối với Nữ giới, trung vị rớt xuống mức 5). Đồng thời, ở bậc `High school` của nhóm `Smoker`, Nữ giới lại có thu nhập trung vị cao hơn hẳn Nam giới (trái ngược với nhóm `Non-smoker`).
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
