Đáp Án Bài Thực Hành Số 5 Học Phần XLSL

Bài viết chia sẻ code .qmd đáp án chi tiết cho bài thực hành số 5 học phần Xử lý số liệu.

Đáp Án Bài Thực Hành Số 5 Học Phần XLSL
Đáp Án Bài Thực Hành Số 5 Học Phần XLSL | Wiky

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ố 5.


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:

Đề Bài Thực Hành 5.html
---
title: "Tên tiêu đề"
author: "www.wiky.io.vn"
format: html
date: today
editor: visual
---

## Tải Packages và Tạo dữ liệu

```{r}
#| warning: false
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, rstatix, car, nortest, ggpubr, corrplot, gtsummary, scales, coin)
theme_set(theme_minimal(base_size = 12))

set.seed(12345)
n <- 500
df <- tibble(
  id       = sprintf("P%03d", 1:n),
  age      = sample(18:80, n, replace = TRUE),
  sex      = factor(sample(c("Nữ", "Nam"), n, replace = TRUE, prob = c(0.55, 0.45))),
  bmi      = round(rnorm(n, 24.5, 3.8), 1),
  sbp      = round(rnorm(n, 125, 15), 0),
  hba1c    = round(rnorm(n, 6.1, 0.8), 1),
  smoker   = factor(sample(c("Không", "Đã cai", "Có"), n, replace = TRUE,
                           prob = c(0.60, 0.20, 0.20))),
  severity = ordered(sample(c("Nhẹ", "Vừa", "Nặng"), n, replace = TRUE,
                            prob = c(0.50, 0.35, 0.15)),
                     levels = c("Nhẹ", "Vừa", "Nặng")),
  admitted = sample(c("Không", "Có"), n, replace = TRUE, prob = c(0.75, 0.25))
)
df$sbp <- round(df$sbp + 0.35*(df$age - 50) + 1.2*(df$bmi - 24.5) +
                ifelse(df$sex == "Nam", 4, 0))
```

## Bài 1 - Kiểm định phân phối chuẩn

**Đặt:**

- $H_0: X \sim \mathcal{N}(\mu, \sigma^2)$ (Dữ liệu `bmi` tuân theo phân phối chuẩn).
- $H_1: X \not\sim \mathcal{N}(\mu, \sigma^2)$ (Dữ liệu `bmi` không tuân theo phân phối chuẩn).

```{r}
#| warning: false
# Q-Q
ggqqplot(df, x = "bmi")

# Shapiro–Wilk
shapiro.test(df$bmi)                              
```

**Kết luận:**

- Trên biểu đồ Q-Q plot, các điểm dữ liệu phân bố bám sát theo đường chéo.
- Kiểm định Shapiro-Wilk trả về p-value lớn hơn 0.05 ($p-value = 0.4351$).
- Do đó, không đủ bằng chứng để bác bỏ giả thuyết $H_{0}$, có thể kết luận rằng dữ liệu `bmi` có phân phối chuẩn.

## Bài 2 - t-test một mẫu

**Đặt:**

-  $H_0: \mu = 6.0$ (Trung bình `hba1c` bằng 6.0%).

- $H_1: \mu \ne 6.0$ (Trung bình `hba1c` khác 6.0%).

```{r}
#| warning: false
# Kiểm định t-test một mẫu với giả thuyết mu = 6.0
df |> rstatix::t_test(hba1c ~ 1, mu = 6.0)

# Tính cỡ ảnh hưởng Cohen's d
df |> rstatix::cohens_d(hba1c ~ 1, mu = 6.0)
```

**Kết luận:**

- Kết quả kiểm định t-test cho $p-value = 0.121$, lớn hơn mức ý nghĩa 0.05. Vì vậy, chưa đủ bằng chứng để bác bỏ $H_{0}$ và có thể nói trung bình `hba1c` không khác biệt có ý nghĩa thống kê so với mức 6.0%.

- Hệ số ảnh hưởng Cohen's $d = 0.0694$, được phân loại ở mức "negligible", chỉ ra rằng sự sai khác (nếu có) là cực kỳ nhỏ và hầu như không có ý nghĩa.

## Bài 3 - t-test hai mẫu độc lập

**Đặt:**

*Kiểm định Levene:*

- $H_0: \sigma_1^2 = \sigma_2^2$ (Phương sai của hai nhóm nam và nữ bằng nhau).

- $H_1: \sigma_1^2 \ne \sigma_2^2$ (Phương sai của hai nhóm nam và nữ khác nhau).

*Kiểm định t-test hai mẫu độc lập:*

- $H_0: \mu_1 = \mu_2$ (Trung bình huyết áp tâm thu của nam và nữ bằng nhau).

- $H_1: \mu_1 \ne \mu_2$ (Trung bình huyết áp tâm thu của nam và nữ khác nhau).

```{r}
#| warning: false
# Kiểm định Levene đánh giá sự đồng nhất phương sai
df |> rstatix::levene_test(sbp ~ sex)

# Vì Levene test cho p > 0.05, ta sử dụng t-test với giả định phương sai gộp
df |> rstatix::t_test(sbp ~ sex, var.equal = TRUE)

# Trực quan hóa bằng Boxplot kèm p-value
ggboxplot(df, x = "sex", y = "sbp", fill = "sex", palette = "viridis") +
  stat_compare_means(method = "t.test", label.x = 1.3) +
  labs(x = "Giới tính", y = "SBP (mmHg)") +
  theme(legend.position = "none")
```

**Kết luận:**

- Kiểm định Levene cho $p-value = 0.494$ (lớn hơn 0.05), do đó không bác bỏ giả thuyết phương sai bằng nhau giữa hai nhóm. Điều này thoả giả định để sử dụng t-test.

- Kết quả t-test cho p-value xấp xỉ $0.0037$ (nhỏ hơn 0.05), qua đó bác bỏ $H_{0}$, chứng tỏ chỉ số SBP trung bình giữa nhóm nam và nhóm nữ có sự khác biệt mang ý nghĩa thống kê.

## Bài 4 - t-test ghép cặp

**Đặt:**

- $H_0: \mu_d = 0$ (Trung bình hiệu số huyết áp tâm thu trước và sau can thiệp bằng 0, tức là can thiệp không làm thay đổi huyết áp).

- $H_1: \mu_d \ne 0$ (Trung bình hiệu số huyết áp tâm thu trước và sau can thiệp khác 0).

```{r}
#| warning: false
# Mô phỏng dữ liệu 60 bệnh nhân
set.seed(7)
pre <- rnorm(60, 140, 12)
post <- pre - rnorm(60, 6, 8)
paired <- tibble(id = 1:60, pre, post) |>
  pivot_longer(c(pre, post), names_to = "thoi_diem", values_to = "sbp") |>
  mutate(thoi_diem = factor(thoi_diem, levels = c("pre", "post")))

# Kiểm định t ghép cặp
paired |> rstatix::t_test(sbp ~ thoi_diem, paired = TRUE)

# Tính cỡ ảnh hưởng Cohen's d
paired |> rstatix::cohens_d(sbp ~ thoi_diem, paired = TRUE)
```

**Kết luận:**

- Kiểm định t ghép cặp cho p-value rất nhỏ ($p < 0.001$), do đó ta có đủ bằng chứng để bác bỏ $H_0$.

- Kết luận huyết áp tâm thu trung bình sau can thiệp thấp hơn trước can thiệp một cách có ý nghĩa thống kê.

- Hệ số ảnh hưởng Cohen's $d = 0.934$ thuộc mức "large", cho thấy sự can thiệp này mang lại hiệu quả giảm huyết áp lớn và có ý nghĩa thực tiễn.

## Bài 5 - So sánh hai tỷ lệ

**Đặt:**

- $H_0: p_1 = p_2$ (Tỷ lệ nhập viện ở nhóm có hút thuốc và nhóm không hút thuốc là như nhau).

- $H_1: p_1 \ne p_2$ (Tỷ lệ nhập viện ở nhóm có hút thuốc và nhóm không hút thuốc là khác nhau).

```{r}
#| warning: false
# Lọc dữ liệu nhóm "Có" và "Không" hút thuốc, lập bảng chéo
tab <- df |>
  filter(smoker %in% c("Không", "Có")) |>
  mutate(smoker = droplevels(smoker)) |>
  count(smoker, admitted) |>
  pivot_wider(names_from = admitted, values_from = n)

# Hoặc dùng hàm table cơ bản
tab2 <- table(df$smoker, df$admitted)
print(tab2)

# Kiểm định 2 tỷ lệ
prop.test(x = tab$Có, n = tab$Có + tab$Không)
```

**Kết luận:**

- Tỷ lệ nhập viện ở nhóm có hút thuốc là $30.7%$, trong khi ở nhóm không hút thuốc là $25.3%$.

- Kiểm định `prop.test` cho $p-value = 0.358$ (lớn hơn 0.05), do đó chưa đủ bằng chứng để bác bỏ $H_0$.

- Khoảng tin cậy 95% của hiệu hai tỷ lệ chứa giá trị 0 (từ -0.056 đến 0.163), cho thấy sự khác biệt này có thể chỉ do sai số chọn mẫu chứ không mang ý nghĩa thống kê.

## Bài 6 - ANOVA và hậu kiểm Tukey

**Đặt:**

- $H_0: \mu_1 = \mu_2 = \mu_3$ (Chỉ số BMI trung bình không có sự khác biệt giữa ba mức độ bệnh: Nhẹ, Vừa, Nặng).

- $H_1:$ Có ít nhất một cặp nhóm mức độ bệnh có chỉ số BMI trung bình khác nhau.

```{r}
#| warning: false
# Kiểm định ANOVA một chiều
df |> rstatix::anova_test(bmi ~ severity)

# Hậu kiểm Tukey HSD
df |> rstatix::tukey_hsd(bmi ~ severity)

# Trực quan hóa dữ liệu bằng boxplot
ggboxplot(df, x = "severity", y = "bmi", fill = "severity", palette = "viridis") +
  labs(x = "Mức độ bệnh", y = "BMI") +
  theme(legend.position = "none")
```

**Kết luận:**

- Kiểm định ANOVA cho p-value $= 0.793$, lớn hơn mức ý nghĩa 0.05. Do đó chưa đủ bằng chứng để bác bỏ $H_0$.

- Kết luận BMI trung bình không khác nhau giữa ba mức độ bệnh.

- Do mô hình chung không có ý nghĩa thống kê, kết quả hậu kiểm Tukey cũng cho thấy tất cả các cặp nhóm đều không có sự khác biệt (tất cả giá trị $p.adj > 0.05$). Biểu đồ boxplot cho thấy sự phân bố BMI giữa ba nhóm là gần như tương đương nhau.

## Bài 7 - Kiểm định phi tham số (Mann-Whitney)

**Đặt:**

- $H_0$: Hai phân phối như nhau (trung vị SBP của nam và nữ bằng nhau).

- $H_1$: Hai phân phối khác nhau (trung vị SBP của nam và nữ khác nhau).

```{r}
#| warning: false
library(coin)

# Kiểm định Mann-Whitney
df |> rstatix::wilcox_test(sbp ~ sex)

# Tính cỡ ảnh hưởng
df |> rstatix::wilcox_effsize(sbp ~ sex)
```

**Kết luận:**

- Kiểm định Mann-Whitney cho p-value nhỏ hơn 0.05 (giống kết quả minh họa lý thuyết là $p=0.007$). Do đó, ta bác bỏ $H_0$ và kết luận phân bố của huyết áp tâm thu giữa nam và nữ có sự khác biệt mang ý nghĩa thống kê.

- Kết luận này hoàn toàn nhất quán với kết quả của kiểm định t-test hai mẫu độc lập ở Bài 3. Hệ số ảnh hưởng $r$ ở mức "small", tương tự như kết quả cỡ ảnh hưởng Cohen's d.

## Bài 8 - Kruskal-Wallis và Dunn

**Đặt:**

- $H_0$: Phân bố `hba1c` là như nhau giữa các nhóm mức độ bệnh.

- $H_1$: Có ít nhất một nhóm có phân bố `hba1c` khác biệt so với các nhóm còn lại.

```{r}
#| warning: false
# Kiểm định Kruskal-Wallis
df |> rstatix::kruskal_test(hba1c ~ severity)

# Hậu kiểm Dunn với hiệu chỉnh Bonferroni
df |> rstatix::dunn_test(hba1c ~ severity, p.adjust.method = "bonferroni")
```

**Kết luận:**

- Kiểm định Kruskal-Wallis trả về $p = 0.838$ (p-value > 0.05), chưa đủ bằng chứng để bác bỏ $H_0$, tức là không có sự khác biệt về phân bố `hba1c` giữa ba mức độ bệnh.

- Kết quả hậu kiểm Dunn (với hiệu chỉnh Bonferroni) cũng đồng nhất với kiểm định chung khi cho thấy tất cả các cặp so sánh (Nhẹ - Vừa, Nhẹ - Nặng, Vừa - Nặng) đều có giá trị $p_{adj} = 1$ (lớn hơn 0.05). Điều này khẳng định không có bất kỳ cặp nhóm mức độ bệnh nào có phân bố `hba1c` thực sự khác biệt so với nhóm còn lại.

## Bài 9 - Chi-square / Fisher

**Đặt:**

- $H_0$: Hai biến độc lập (Tình trạng hút thuốc và việc nhập viện không có mối liên quan).

- $H_1$: Hai biến có mối liên quan với nhau.

```{r}
#| warning: false
# Lập bảng chéo
tab_chi <- table(df$smoker, df$admitted)
print(tab_chi)

# Kiểm định Chi-square
chisq_res <- chisq.test(tab_chi)
print(chisq_res)

# Kiểm tra tần số kỳ vọng
print(chisq_res$expected)

# Kiểm định chính xác Fisher
fisher.test(tab_chi)
```

**Kết luận:**

- Kiểm định Chi-square trả về $p-value = 0.446 > 0.05$. Chưa đủ bằng chứng bác bỏ $H_0$, kết luận hai biến không có mối liên quan mang ý nghĩa thống kê.

- **Kiểm tra điều kiện:** Ta thấy tất cả các tần số kỳ vọng tại các ô ($E_{ij}$) đều lớn hơn hoặc bằng 5 ($E_{ij} \ge 5$), do đó xấp xỉ Chi-square là phù hợp.

- **Khi nào dùng Fisher:** Kiểm định chính xác Fisher được khuyên dùng khi có nhiều ô mang tần số kỳ vọng nhỏ (thường là dưới 5, đặc biệt trong bảng $2 \times 2$) vì nó tính toán p-value dựa trên phân phối siêu bội chính xác thay vì xấp xỉ.

## Bài 10 - Tương quan Pearson, Spearman và ma trận

**Đặt:**

- $H_0: \rho = 0$ (Không có mối liên hệ tương quan giữa tuổi và huyết áp tâm thu).

- $H_1: \rho \ne 0$ (Có mối liên hệ tương quan giữa hai biến).

```{r}
#| warning: false
# Tương quan Pearson
df |> rstatix::cor_test(age, sbp, method = "pearson")

# Tương quan Spearman
df |> rstatix::cor_test(age, sbp, method = "spearman")

# Ma trận tương quan
M <- df |> 
  select(age, bmi, sbp, hba1c) |> 
  cor(use = "complete.obs")

corrplot(M, method = "color", addCoef.col = "black", tl.col = "black", type = "upper")
```

**Kết luận:**

- **Pearson & Spearman:** Cả hai phương pháp kiểm định đều trả về p-value rất nhỏ ($p < 0.001$), bác bỏ mạnh mẽ $H_0$. Điều này khẳng định có tồn tại tương quan tuyến tính mang ý nghĩa thống kê giữa tuổi và SBP.

- **Ma trận tương quan:** Biểu đồ thể hiện hệ số tương quan giữa các cặp biến định lượng. Hệ số lớn nhất thuộc về cặp `age`-`sbp` (quanh 0.42), cặp có hệ số cao tiếp theo là `bmi`-`sbp`.

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

About the author

Ng P Nhật Huy
Chia sẻ là đam mê

إرسال تعليق