BÀI TẬP TUẦN 07

Trần Thị Huỳnh Nga

2025-06-09

Phần I. TỔNG QUAN DỮ LIỆU

   Bộ dữ liệu được sử dụng trong phân tích này bao gồm 9152 quan sát về đặc điểm sức khỏe, lối sống và tình trạng bệnh lý của một nhóm người được khảo sát ở các khu vực khác nhau. Mục tiêu là phân tích mối quan hệ, các yếu tố nguy cơ liên quan đến các bệnh không lây nhiễm như: tim mạch, tiểu đường, tăng huyết áp…Dữ liệu bao gồm 6 biến định tính và 3 biến định lượng.

install.packages("readxl")
## Warning: package 'readxl' is in use and will not be installed
library(readxl)
data <- read_excel("D:/data/bo_so_lieu_dich_te_9152.xlsx",)

1. Cấu trúc dữ liệu

dim(data)
## [1] 9152    9
str(data)
## tibble [9,152 × 9] (S3: tbl_df/tbl/data.frame)
##  $ ID                   : num [1:9152] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Tuổi                 : num [1:9152] 57 47 59 72 46 46 73 61 42 58 ...
##  $ Chỉ số BMI           : num [1:9152] 29 27.5 24.5 23.9 26.6 27.5 30.4 29.7 23.6 25.1 ...
##  $ Vận động thường xuyên: chr [1:9152] "Không vận động" "Vận động" "Vận động" "Vận động" ...
##  $ Bệnh tiểu đường      : chr [1:9152] "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" ...
##  $ Tăng huyết áp        : chr [1:9152] "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" ...
##  $ Bệnh tim mạch        : chr [1:9152] "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" "Không mắc bệnh" ...
##  $ Giới tính            : chr [1:9152] "Nam" "Nam" "Nữ" "Nữ" ...
##  $ Khu vực              : chr [1:9152] "Miền Trung" "Miền Nam" "Miền Nam" "Miền Bắc" ...
colSums(is.na(data))
##                    ID                  Tuổi            Chỉ số BMI 
##                     0                     0                     0 
## Vận động thường xuyên       Bệnh tiểu đường         Tăng huyết áp 
##                     0                     0                     0 
##         Bệnh tim mạch             Giới tính               Khu vực 
##                     0                     0                     0
cat("Tổng số dữ liệu bị thiếu là", sum(is.na(data)))
## Tổng số dữ liệu bị thiếu là 0

2. Lọc biến định tính và chuyển đổi cấu trúc

names(data)
## [1] "ID"                    "Tuổi"                  "Chỉ số BMI"           
## [4] "Vận động thường xuyên" "Bệnh tiểu đường"       "Tăng huyết áp"        
## [7] "Bệnh tim mạch"         "Giới tính"             "Khu vực"
bdt <- c("Vận động thường xuyên", "Bệnh tiểu đường", "Tăng huyết áp", "Bệnh tim mạch", "Giới tính", "Khu vực")
data[bdt] <- lapply(data[bdt], as.factor)

# In tên biến, số lượng nhãn và tên các nhãn
for (var in bdt) {
  cat("\nBiến:", var, "\n")
  cat("Số nhãn:", length(levels(data[[var]])), "\n")
  cat("Danh sách nhãn:", paste(levels(data[[var]]), collapse = ", "), "\n")
}
## 
## Biến: Vận động thường xuyên 
## Số nhãn: 2 
## Danh sách nhãn: Không vận động, Vận động 
## 
## Biến: Bệnh tiểu đường 
## Số nhãn: 2 
## Danh sách nhãn: Không mắc bệnh, Mắc bệnh 
## 
## Biến: Tăng huyết áp 
## Số nhãn: 2 
## Danh sách nhãn: Không mắc bệnh, Mắc bệnh 
## 
## Biến: Bệnh tim mạch 
## Số nhãn: 2 
## Danh sách nhãn: Không mắc bệnh, Mắc bệnh 
## 
## Biến: Giới tính 
## Số nhãn: 2 
## Danh sách nhãn: Nam, Nữ 
## 
## Biến: Khu vực 
## Số nhãn: 3 
## Danh sách nhãn: Miền Bắc, Miền Nam, Miền Trung
str(data)
## tibble [9,152 × 9] (S3: tbl_df/tbl/data.frame)
##  $ ID                   : num [1:9152] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Tuổi                 : num [1:9152] 57 47 59 72 46 46 73 61 42 58 ...
##  $ Chỉ số BMI           : num [1:9152] 29 27.5 24.5 23.9 26.6 27.5 30.4 29.7 23.6 25.1 ...
##  $ Vận động thường xuyên: Factor w/ 2 levels "Không vận động",..: 1 2 2 2 2 1 2 2 2 1 ...
##  $ Bệnh tiểu đường      : Factor w/ 2 levels "Không mắc bệnh",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Tăng huyết áp        : Factor w/ 2 levels "Không mắc bệnh",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Bệnh tim mạch        : Factor w/ 2 levels "Không mắc bệnh",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Giới tính            : Factor w/ 2 levels "Nam","Nữ": 1 1 2 2 2 1 2 2 1 1 ...
##  $ Khu vực              : Factor w/ 3 levels "Miền Bắc","Miền Nam",..: 3 2 2 1 1 3 3 1 2 1 ...

Phần II. PHÂN TÍCH CÁC BIẾN ĐỊNH TÍNH

1. Phân tích mô tả

1.1 Biến (Giới tính)

   Biến (Giới tính) thể hiện số lượng người được khảo sát mắc bệnh phân loại dựa trên giới tính.

table_gt <- table(data$"Giới tính")
kable(
  as.data.frame(table_gt),
  col.names = c("Giới tính", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát theo giới tính**</center>"
)
Table:
Bảng: Số lượng người khảo sát theo giới tính
Giới tính Số lượng
Nam 4527
Nữ 4625 
gt <- round(table(data$"Giới tính")/sum(nrow(data))*100 ,1)
label <- paste(gt, "%")
pie(gt, main ="BIỂU ĐỒ PHÂN BỔ SỐ LƯỢNG NGƯỜI KHẢO SÁT THEO GIỚI TÍNH", col = brewer.pal(2, "Pastel1")
, radius =1, border = NA)
## Warning in brewer.pal(2, "Pastel1"): minimal value for n is 3, returning requested palette with 3 different levels
legend("topright",legend = label, fill = brewer.pal(2, "Pastel1"), title = "Giới tính", cex = 0.8)
## Warning in brewer.pal(2, "Pastel1"): minimal value for n is 3, returning requested palette with 3 different levels

Nhận xét

   Kết quả của cuộc khảo sát được thu thập không có sự chênh lệch lớn giữa Nam và Nữ. Nữ chiếm 50.5% và Nam chiếm 49.5%.

1.2 Biến (Vận động thường xuyên)

   Biến (Vận động thường xuyên) phân loại nhóm người mắc bệnh có vận động so với nhóm người không vận động, nhằm xem xét tỷ lệ nguy cơ mắc bệnh.

table_ht <- table(data$"Vận động thường xuyên")
kable(
  as.data.frame(table_ht),
  col.names = c("Vận động thường xuyên", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát có vận động**</center>"
)
Table:
Bảng: Số lượng người khảo sát có vận động
Vận động thường xuyên Số lượng
Không vận động 3636
Vận động 5516 
ht <- round(table(data$"Vận động thường xuyên")/sum(nrow(data))*100 ,1)

labels <- paste0(ht, "%")
pie(ht,labels = labels, main ="BIỂU ĐỒ TẦN SUẤT NGƯỜI KHẢO SÁT CÓ VẬN ĐỘNG THƯỜNG XUYÊN", col = brewer.pal(2, "Accent")
, radius =1, border = NA)
## Warning in brewer.pal(2, "Accent"): minimal value for n is 3, returning requested palette with 3 different levels
legend("topright",legend = names(ht), fill = brewer.pal(2, "Accent"), title = "Người được khảo sát", cex = 0.8)
## Warning in brewer.pal(2, "Accent"): minimal value for n is 3, returning requested palette with 3 different levels

Nhận xét

   Nhìn vào biểu đồ tròn có thể thấy sự chênh lệch khá lớn giữa tỷ lệ người có vận động và không vận động với lần lượt là 60.3% và 39.7% trong tổng số người được khảo sát.

1.3 Biến (Bệnh tiểu đường)

   Biến (Bệnh tiểu đường) phân loại nhóm người được khảo sát hiện đang mắc bệnh hoặc không. Nhằm xem xét mối quan hệ với các hoạt động thường ngày, chỉ số cơ thể và bệnh tim mạch.

table_td <- table(data$"Bệnh tiểu đường")
kable(
  as.data.frame(table_td),
  col.names = c("Tiểu đường", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát mắc bệnh tiểu đường**</center>"
)
Table:
Bảng: Số lượng người khảo sát mắc bệnh tiểu đường
Tiểu đường Số lượng
Không mắc bệnh 8135
Mắc bệnh 1017 
td <- round(table(data$"Bệnh tiểu đường")/sum(nrow(data))*100 ,1)

labels <- paste0(td, "%")
pie(td,labels = labels, main ="BIỂU ĐỒ TẦN SUẤT NGƯỜI MẮC BỆNH TIỂU ĐƯỜNG", col = brewer.pal(2, "Set2")
, radius =1, border = NA)
## Warning in brewer.pal(2, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
legend("topright",legend = names(td), fill = brewer.pal(2, "Set2"), title = "Tiểu đường", cex = 0.8)
## Warning in brewer.pal(2, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Nhận xét

   Tỷ lệ mắc bệnh tiểu đường trong tổng số người khảo sát chiếm 11.1% và người không mắc là 88.9%,

1.4 Biến (Tăng huyết áp)

   Biến (Tăng huyết áp) phân loại nhóm người được khảo sát hiện đang mắc bệnh hoặc không. Nhằm đánh giá mối quan hệ với bệnh tiểu đường.

table_tha <- table(data$"Tăng huyết áp")
kable(
  as.data.frame(table_tha),
  col.names = c("Tăng huyết áp", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát mắc bệnh tăng huyết áp**</center>"
)
Table:
Bảng: Số lượng người khảo sát mắc bệnh tăng huyết áp
Tăng huyết áp Số lượng
Không mắc bệnh 7964
Mắc bệnh 1188 
ha <- round(table(data$"Tăng huyết áp")/sum(nrow(data))*100 ,1)
labels <- paste0(ha, "%")
pie(ha, labels = labels, main ="BIỂU ĐỒ TẦN SUẤT SỐ NGƯỜI MẮC BỆNH TĂNG HUYẾT ÁP", col = brewer.pal(2, "Set1")
, radius =1, border = NA)
## Warning in brewer.pal(2, "Set1"): minimal value for n is 3, returning requested palette with 3 different levels
legend("topright",legend = names(ha), fill = brewer.pal(2, "Set1"), title = "Tăng huyết áp", cex = 0.8)
## Warning in brewer.pal(2, "Set1"): minimal value for n is 3, returning requested palette with 3 different levels

Nhận xét

   Tỷ lệ người mắc bệnh tăng huyết áp chiếm 13% trong tổng số người được khảo sát tại các khu vực.

1.5 Biến (Bệnh tim mạch)

   Biến (Bệnh tim mạch) phân loại nhóm người được khảo sát hiện đang mắc bệnh hoặc không. Nhằm xem xét mối quan hệ với các bệnh tăng huyết áp và bệnh tiểu đường.

table_tm <- table(data$"Bệnh tim mạch")
kable(
  as.data.frame(table_tm),
  col.names = c("Bệnh tim mạch", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát mắc bệnh tim mạch**</center>"
)
Table:
Bảng: Số lượng người khảo sát mắc bệnh tim mạch
Bệnh tim mạch Số lượng
Không mắc bệnh 8659
Mắc bệnh 493 
tm <- round(table(data$"Bệnh tim mạch")/sum(nrow(data))*100 ,1)
labels <- paste0(tm, "%")
pie(tm,labels = labels, main ="BIỂU ĐỒ TẦN SUẤT SỐ NGƯỜI MẮC BỆNH TIM MẠCH", col = brewer.pal(2, "Set3")
, radius =1, border = NA)
## Warning in brewer.pal(2, "Set3"): minimal value for n is 3, returning requested palette with 3 different levels
legend("topright",legend = names(tm), fill = brewer.pal(2, "Set3"), title = "Bệnh tim mạch", cex = 0.8)
## Warning in brewer.pal(2, "Set3"): minimal value for n is 3, returning requested palette with 3 different levels

Nhận xét

   Tỷ lệ mắc bệnh tim mạch trong tổng số người khảo sát chiếm 5.4% và người không mắc là 94.6%,

1.6 Biến (Khu vực)

   Biến (Khu vực) phân loại nhóm người được khảo sát tại các khu vực khác nhau nhằm đánh gía khách quan nhiều yếu tố ảnh hưởng nhưng có thể không quản lí được.

table_kv <- table(data$"Khu vực")
kable(
  as.data.frame(table_kv),
  col.names = c("Khu vực", "Số lượng"),
  caption = "<center>**Bảng: Số lượng người khảo sát đến từ các khu vục**</center>"
)
Table:
Bảng: Số lượng người khảo sát đến từ các khu vục
Khu vực Số lượng
Miền Bắc 3071
Miền Nam 3053
Miền Trung 3028 
kv <- round(table(data$"Khu vực")/sum(nrow(data))*100 ,1)
labels <- paste0(kv, "%")
pie(kv,labels = labels, main ="BIỂU ĐỒ TẦN SUẤT LƯỢNG NGƯỜI ĐƯỢC KHẢO SÁT TẠI CÁC KHU VỰC", col = brewer.pal(3, "Set1")
, radius =1, border = NA)
legend("topright",legend = names(kv), fill = brewer.pal(3, "Set1"), title = "Khu vực", cex = 0.8)

Nhận xét

   Lượng người khảo sát được phân bổ khá đồng đều giữa 3 khu vực, không quá chênh lệch nhằm đánh giá được tổng quan các yếu tố đặc thù có thể tác động đến nguy cơ mắc bênh cao hơn.

2. Ước lượng Khoảng và Kiểm định Giả thuyết thống kê

Thực hiện ước lượng khoảng và kiểm định giả thuyết cho 2 biến phụ thuộc là biến (Bệnh tiểu đường) và biến (Bệnh tim mạch).

2.1 Biến (Bệnh tiểu đường) với hạng mục (Mắc bệnh)

a. Ước lượng khoảng tin cậy

n <- nrow(data)
n_td <- sum(data$"Bệnh tiểu đường" == "Mắc bệnh")
x_td <- n_td / n
z <- qnorm(0.975)
se_td <- sqrt(x_td * (1 - x_td) / n)
lower_td <- x_td - z * se_td
upper_td <- x_td + z * se_td
cat("Khoảng tin cậy 95% cho tỷ lệ mắc bệnh tiểu đường là:", round(lower_td, 4), "-", round(upper_td, 4), "\n")
## Khoảng tin cậy 95% cho tỷ lệ mắc bệnh tiểu đường là: 0.1047 - 0.1176

Nhận xét

  • Với mức tin cậy 95%, khoảng ước lượng thu được cho biết tỷ lệ người mắc bệnh tiểu đường trong quần thể là từ 10.47% đến 11.76.

  • Nếu lặp lại quá trình lấy mẫu nhiều lần từ quần thể và tính khoảng tin cậy 95% cho mỗi lần, thì 95% các khoảng từ 10.47% đến 11.76% sẽ chứa tỷ lệ thật của người mắc bệnh tiểu đường.

b. Kiểm định giả thuyết

Thực hiện kiểm định giả thuyết cho rằng tỷ lệ người mắc bệnh tiểu đường là dưới 20%, ta có:

Bài toán kiểm định:

  • \(H_0\): Tỷ lệ người mắc bệnh tiểu đường \(< 0.2\)

  • \(H_1\): Tỷ lệ người mắc bệnh tiểu đường \(\geq 0.2\)

prop.test(x = n_td, n = n, p = 0.2, alternative = "greater", conf.level = 0.95)
## 
##  1-sample proportions test with continuity correction
## 
## data:  n_td out of n, null probability 0.2
## X-squared = 451.27, df = 1, p-value = 1
## alternative hypothesis: true p is greater than 0.2
## 95 percent confidence interval:
##  0.1057806 1.0000000
## sample estimates:
##         p 
## 0.1111233

Kết quả cho thấy:

  • Giá trị P- value = 1

  • Với độ tin cậy 95%, p-value = 1 > 0.05. Chưa có cơ sở bác bỏ giả thuyết \(H_0\), tức có thể nói rằng tỷ lệ người mắc bệnh tiểu đường có thể dưới 20%.

2.2 Biến (Bệnh tim mạch) với hạng mục (Không mắc bệnh)

a. Ước lượng khoảng tin cậy

n_tm <- sum(data$"Bệnh tim mạch" == "Không mắc bệnh")
x_tm <- n_tm / n
z <- qnorm(0.975)
se_tm <- sqrt(x_tm * (1 - x_tm) / n)
lower_tm <- x_tm - z * se_tm
upper_tm <- x_tm + z * se_tm
cat("Khoảng tin cậy 95% cho tỷ lệ không mắc bệnh tim mạch là:", round(lower_tm, 4), "-", round(upper_tm, 4), "\n")
## Khoảng tin cậy 95% cho tỷ lệ không mắc bệnh tim mạch là: 0.9415 - 0.9508

Nhận xét

  • Với mức tin cậy 95%, khoảng ước lượng thu được cho biết tỷ lệ người không mắc bệnh tim mạch trong quần thể là từ 94.15% đến 95.08%.

  • Nếu lặp lại quá trình lấy mẫu nhiều lần từ quần thể và tính khoảng tin cậy 95% cho mỗi lần, thì 95% các khoảng từ 94.15% đến 95.08% sẽ chứa tỷ lệ thật của người không mắc bệnh tim mạch.

b. Kiểm định giả thuyết

Thực hiện kiểm định giả thuyết cho rằng tỷ lệ người không mắc bệnh tim mạch là hơn 97%, ta có:

Bài toán kiểm định:

  • \(H_0\): Tỷ lệ người không mắc bệnh tim mạch \(> 0.97\)

  • \(H_1\): Tỷ lệ người không mắc bệnh tim mạch \(\le 0.97\)

prop.test(x = n_tm, n = n, p = 0.97, alternative = "less", conf.level = 0.95)
## 
##  1-sample proportions test with continuity correction
## 
## data:  n_tm out of n, null probability 0.97
## X-squared = 178.35, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is less than 0.97
## 95 percent confidence interval:
##  0.0000000 0.9499362
## sample estimates:
##        p 
## 0.946132

Kết quả cho thấy:

  • Giá trị P- value < 2.2e-16

  • Với độ tin cậy 95%, p-value = 2.2e-16 < 0.05. Bác bỏ giả thuyết \(H_0\), tức có thể nói rằng tỷ lệ người không mắc bệnh tim mạch không thể hơn 97%.

Phần III. PHÂN TÍCH MỐI QUAN HỆ GIỮA HAI BIẾN VÀ CÁC CHỈ SỐ THỐNG KÊ

1. Cặp biến (Vận động thường xuyên) và (Bệnh tiểu đường)

Trong đó, biến (Vận động thường xuyên) là biến độc lập và (Bệnh tiểu đường) là biến phụ thuộc.

data$"Bệnh tiểu đường" <- factor(data$"Bệnh tiểu đường", levels = c("Mắc bệnh", "Không mắc bệnh"))  
cb2 <- table(data$"Vận động thường xuyên", data$"Bệnh tiểu đường")
ppb2 <- addmargins(cb2)
kable(ppb2,
      caption = "<center>**Bảng Tần suất chéo: (`Vận động thường xuyên`) và (`Bệnh tiểu đường`)**</center>",
      align = "c")
Table:
Bảng Tần suất chéo: (Vận động thường xuyên) và (Bệnh tiểu đường)
Mắc bệnh Không mắc bệnh Sum
Không vận động 551 3085 3636
Vận động 466 5050 5516
Sum 1017 8135 9152 
data_percent1 <- data %>%
  filter(!is.na(`Vận động thường xuyên`) & !is.na(`Bệnh tiểu đường`)) %>%
  count(`Vận động thường xuyên`, `Bệnh tiểu đường`) %>%
  group_by(`Vận động thường xuyên`) %>%
  mutate(perc = n / sum(n) * 100)

ggplot(data_percent1, aes(x = `Vận động thường xuyên`, y = perc, fill = `Bệnh tiểu đường`)) +
  geom_col(position = "stack") +
  geom_text(aes(label = paste0(round(perc, 1), "%")),
            position = position_stack(vjust = 0.5),
            color = "black", size = 4) +
  labs(
    title = "Tỷ lệ mắc bệnh tiểu đường theo tình trạng vận động",
    x = "Tình trạng vận động",
    y = "Tỷ lệ phần trăm (%)",
    fill = "Bệnh tiểu đường"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 14))

Nhận xét

   Nhìn chung, tỷ lệ mắc bệnh tiểu đường ở nhóm có hoạt động thể chất thường xuyên (8.4%) thấp hơn so với nhóm không vận động (15.2%). Đồng thời, tỷ lệ không mắc bệnh ở nhóm vận động cao hơn đáng kể (91.6%), cho thấy hoạt động thể chất có thể là một yếu tố bảo vệ giúp giảm nguy cơ mắc bệnh tiểu đường.

a. Kiểm định Chi-bình phương

Thực hiện kiểm định Chi-squared nhằm xác định mối liên hệ giữa hai biến (Vận động thường xuyên) và (Bệnh tiểu đường) có ý nghĩa thống kê hay không.

Bài toán kiểm định:

  • \(H_0\): Hai biến (Vận động thường xuyên) và (Bệnh tiểu đường) độc lập với nhau (không có mối liên hệ).

  • \(H_1\): Hai biến (Vận động thường xuyên) và (Bệnh tiểu đường) có mối liên hệ với nhau.

chisq_test1 <- chisq.test(cb2)
print(chisq_test1)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cb2
## X-squared = 99.091, df = 1, p-value < 2.2e-16

Kết quả của bài toán có:

  • Giá trị Chi-bình phương là 99.091

  • Bậc tự do df = 1

  • Giá trị P- value < 2.2e-16

Với mức ý nghĩa 5%, p - value < 2.2e-16 < 0.05. Bác bỏ giả thuyết \(H_0\). Tức có mối liên hệ giữa hai biến (Vận động thường xuyên) và (Bệnh tiểu đường).

b. Tỷ lệ tương đối (Relative Risk - RR)

cb2_RelRisk <- round(RelRisk(cb2), 1)
cat("Relative Risk:", cb2_RelRisk, "\n")
## Relative Risk: 1.8

Nhận xét:

   Kết quả RR = 1.8 cho biết rằng tỷ lệ người không vận động có nguy cơ mắc bệnh tiểu đường cao hơn khoảng 1.8 lần so với người vận động thường xuyên.

c. Tỷ lệ chênh (Odds Ratio - OR) và Khoảng tin cậy 95%

Odds2_1 <- round((551/3085) ,4)
cat("Odds Nhóm người không vận động có nguy cơ mắc bệnh tiểu đường là", Odds2_1, "\n")
## Odds Nhóm người không vận động có nguy cơ mắc bệnh tiểu đường là 0.1786
Odds2_2 <- round((466/5050) ,4)
cat("Odds Nhóm người vận động thường xuyên có nguy cơ mắc bệnh tiểu đường là", Odds2_2, "\n")
## Odds Nhóm người vận động thường xuyên có nguy cơ mắc bệnh tiểu đường là 0.0923
cb2_OR <- OddsRatio(cb2)
cat("Odds Ratio:", cb2_OR, "\n")
## Odds Ratio: 1.935539
ktc_2 <- OddsRatio(cb2,conf.level = .95)
kable(ktc_2,
      caption = "<center>**Bảng ước lượng KTC Odds Ratio**</center>",
      align = "c")
Table:
Bảng ước lượng KTC Odds Ratio
x
odds ratio 1.935539
lwr.ci 1.697500
upr.ci 2.206958 
cat("Khoảng tin cậy 95% cho Odds Ratio là:", 1.697500, "-", 2.206958, "\n")
## Khoảng tin cậy 95% cho Odds Ratio là: 1.6975 - 2.206958

Nhận xét:

  • Odds_1 = 0.1786 cho biết xác suất mắc bệnh tiểu đường so với xác suất không mắc của người không vận động là 0.178. Tức, trong nhóm người không vận động, cứ 1 người không mắc bệnh, thì có khoảng 0.1786 người mắc bệnh tiểu đường.

  • Odds_2 = 0.0923 cho biết xác suất mắc bệnh tiểu đường so với xác suất không mắc của người vận động thường xuyên là 0.0923. Tức, trong nhóm người vận động thường xuyên, cứ 1 người không mắc bệnh, thì có khoảng 0.0923 người mắc bệnh tiểu đường.

  • Kết quả OR = 1.9355388 cho biết rằng khả năng mắc bệnh tiểu đường của người không vận động so với người vận động thường xuyên là khoảng 2 lần.

  • Kết quả với CL 95%: 1.697500 - 2.206958, khoảng tin cậy không chứa giá trị 1 nên kết quả có ý nghĩa thống kê.

==> Tóm lại, không vận động có thể là yếu tố làm tăng nguy cơ mắc bệnh tiểu đường, với độ tin cậy cao. Mức tăng rủi ro có thể dao động từ 1.698 đến 2.207 lần.

2. Cặp biến (Bệnh tiểu đường) và (Bệnh tim mạch)

Trong đó, biến (Bệnh tiểu đường) là biến độc lập và (Bệnh tim mạch) là biến phụ thuộc.

data$"Bệnh tiểu đường" <- factor(data$"Bệnh tiểu đường", levels = c("Mắc bệnh", "Không mắc bệnh")) 
data$"Bệnh tim mạch" <- factor(data$"Bệnh tim mạch", levels = c("Mắc bệnh", "Không mắc bệnh"))  
cb1 <- table(data$"Bệnh tiểu đường", data$"Bệnh tim mạch")
ppb <- addmargins(cb1)
kable(ppb,
      caption = "<center>**Bảng Tần suất chéo: (`Bệnh tiểu đường`) và (`Bệnh tim mạch`)**</center>",
      align = "c")
Table:
Bảng Tần suất chéo: (Bệnh tiểu đường) và (Bệnh tim mạch)
Mắc bệnh Không mắc bệnh Sum
Mắc bệnh 122 895 1017
Không mắc bệnh 371 7764 8135
Sum 493 8659 9152 
# Tạo bảng tóm tắt theo tỷ lệ phần trăm từng nhóm bệnh tiểu đường
data_percent <- data %>%
  filter(!is.na(`Bệnh tiểu đường`) & !is.na(`Bệnh tim mạch`)) %>%
  count(`Bệnh tiểu đường`, `Bệnh tim mạch`) %>%
  group_by(`Bệnh tiểu đường`) %>%
  mutate(perc = n / sum(n) * 100)

ggplot(data_percent, aes(x = `Bệnh tiểu đường`, y = perc, fill = `Bệnh tim mạch`)) +
  geom_col(position = "stack") +
  geom_text(aes(label = paste0(round(perc, 1), "%")),
            position = position_stack(vjust = 0.5),
            color = "black", size = 4) +
  labs(
    title = "Tỷ lệ mắc bệnh tim mạch theo tình trạng bệnh tiểu đường",
    x = "Tình trạng bệnh tiểu đường",
    y = "Tỷ lệ phần trăm (%)",
    fill = "Tim mạch"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"))

Nhận xét

   Nhìn chung, người mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch cao gần gấp đôi so với người không mắc bệnh tiểu đường (12% với 4.6%). Điều này cho thấy tiểu đường là một yếu tố nguy cơ đáng kể của bệnh tim mạch.

a. Kiểm định Chi-bình phương

Thực hiện kiểm định Chi-squared nhằm xác định mối liên hệ giữa hai biến (Bệnh tiểu đường) và (Bệnh tim mạch) có ý nghĩa thống kê hay không.

Bài toán kiểm định:

  • \(H_0\): Hai biến (Bệnh tiểu đường) và (Bệnh tim mạch) độc lập với nhau (không có mối liên hệ).

  • \(H_1\): Hai biến (Bệnh tiểu đường) và (Bệnh tim mạch) có mối liên hệ với nhau.

chisq_test2 <- chisq.test(cb1)
print(chisq_test2)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cb1
## X-squared = 96.609, df = 1, p-value < 2.2e-16

Kết quả của bài toán có:

  • Giá trị Chi-bình phương là 96.609

  • Bậc tự do df = 1

  • Giá trị P- value < 2.2e-16

Với mức ý nghĩa 5%, p - value < 2.2e-16 < 0.05. Bác bỏ giả thuyết \(H_0\). Tức có mối liên hệ giữa hai biến (Bệnh tiểu đường) và (Bệnh tim mạch).

b. Tỷ lệ tương đối (Relative Risk - RR)

cb1_RelRisk <- round(RelRisk(cb1), 1)
cat("Relative Risk:", cb1_RelRisk, "\n")
## Relative Risk: 2.6

Nhận xét:

   Kết quả RR = 2.6 cho biết rằng người mắc bệnh tiểu đường có tỷ lệ mắc bệnh về tim mạch gấp 2.6 lần so với người không mắc bệnh tiểu đường.

b. Tỷ lệ chênh (Odds Ratio - OR) và Khoảng tin cậy 95%

Odds_1 <- round((122/895) ,3)
print(Odds_1)
## [1] 0.136
cat("Odds Nhóm người mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch là", Odds_1, "\n")
## Odds Nhóm người mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch là 0.136
Odds_2 <- round((371/7764) ,3)
cat("Odds Nhóm người không mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch là", Odds_2, "\n")
## Odds Nhóm người không mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch là 0.048
cb1_OR <- OddsRatio(cb1)
cat("Odds Ratio:", cb1_OR, "\n")
## Odds Ratio: 2.852649
ktc <- OddsRatio(cb1,conf.level = .95)
kable(ktc,
      caption = "<center>**Bảng ước lượng KTC Odds Ratio**</center>",
      align = "c")
Table:
Bảng ước lượng KTC Odds Ratio
x
odds ratio 2.852650
lwr.ci 2.298626
upr.ci 3.540206 
cat("Khoảng tin cậy 95% cho Odds Ratio là:", 2.298626, "-", 3.540206, "\n")
## Khoảng tin cậy 95% cho Odds Ratio là: 2.298626 - 3.540206

Nhận xét:

  • Odds_1 = 0.136 cho biết xác suất mắc bệnh so với xác suất không mắc bệnh tim mạch trong nhóm người bị bệnh tiểu đường là 0.136.

  • Odds_2 = 0.048 cho biết xác suất mắc bệnh so với xác suất không mắc bệnh tim mạch trong nhóm người không bị bệnh tiểu đường là 0.048.

  • Kết quả OR = 2.8526495 cho biết rằng khả năng mắc bệnh tim mạch của nhóm người bệnh tiểu đường cao hơn nhóm người không bị tiểu đường là 2.8526495.

  • Kết quả với CL 95%: 2.298626 - 3.540206, khoảng tin cậy không chứa giá trị 1 nên kết quả có ý nghĩa thống kê.

==> Tóm lại, bệnh tiểu đường có thể là yếu tố làm tăng nguy cơ mắc bệnh tim mạch với độ tin cậy cao. Mức tăng rủi ro có thể dao động từ 2.2987 đến 3.54 lần.

PHẦN IV. MÔ HÌNH HỒI QUY VỚI BIẾN NHỊ PHÂN

1. Hồi quy Logistic

Mô hình hồi quy logistic được sử dụng nhằm phân tích xác suất Bệnh tim mạch(mắc bênh = 1, không mắc bệnh = 0) dựa trên các biến độc lập bao gồm:

  • Biến Tăng huyết áp(Không mắc bệnh)

  • Biến Bệnh tiểu đường(Không mắc bệnh)

  • Biến Vận động thường xuyên(Vận động)

  • Biến Tuổi

  • Biến Chỉ số BMI

data$"Tăng huyết áp" <- relevel(data$"Tăng huyết áp", ref = "Không mắc bệnh")
data$"Bệnh tiểu đường" <- relevel(data$"Bệnh tiểu đường", ref = "Không mắc bệnh")
data$"Vận động thường xuyên" <- relevel(data$"Vận động thường xuyên", ref = "Vận động")
data$"Bệnh tim mạch" <- factor(data$"Bệnh tim mạch", levels = c('Không mắc bệnh','Mắc bệnh'))
reglogit <- glm(`Bệnh tim mạch` ~ `Tăng huyết áp` + `Bệnh tiểu đường` + `Tuổi` + `Vận động thường xuyên` + `Chỉ số BMI`, data = data, family = binomial(link = 'logit')) 
summary(reglogit)
## 
## Call:
## glm(formula = `Bệnh tim mạch` ~ `Tăng huyết áp` + `Bệnh tiểu đường` + 
##     Tuổi + `Vận động thường xuyên` + `Chỉ số BMI`, 
##     family = binomial(link = "logit"), data = data)
## 
## Coefficients:
##                                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           -3.840720   0.383915 -10.004  < 2e-16 ***
## `Tăng huyết áp`Mắc bệnh                1.161752   0.104749  11.091  < 2e-16 ***
## `Bệnh tiểu đường`Mắc bệnh              0.984381   0.113619   8.664  < 2e-16 ***
## Tuổi                                   0.011173   0.003155   3.542 0.000397 ***
## `Vận động thường xuyên`Không vận động  0.219242   0.095482   2.296 0.021667 *  
## `Chỉ số BMI`                          -0.003766   0.013393  -0.281 0.778597    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3839.3  on 9151  degrees of freedom
## Residual deviance: 3621.4  on 9146  degrees of freedom
## AIC: 3633.4
## 
## Number of Fisher Scoring iterations: 6

Quy ước: Biến Tăng huyết áp = THA, biến Bệnh tiểu đường = BTĐ, biến Tuổi = T, biến Chỉ số BMI = BMI, biến Vận động thường xuyên = VĐ.

Mô hình Logit có dạng:

      \(logit(\pi)\) = -3.840720 + 1.161752THA + 0.9843812BTĐ + 0.011173T + 0.219242VĐ -0.003766BMI

Nhận xét:

  • Dựa vào kết quả p - value < 0.05 của tất cả biến giải thích được đưa vào mô hình, điều này cho thấy đây là các biến có ý nghĩa thống kê và ảnh hưởng đến xác suất mắc bệnh tim mạch. Tuy nhiên Chỉ số BMI với p-value = 0.779 > 0.05, tức không có ý nghĩa trong mô hình này.

  • Hệ số của biến THA = 1.162, tức: \[OR = e^{1.162} \approx 3.196 > 1\] cho thấy mắc bệnh tăng huyết áp làm tăng tỷ lệ mắc bệnh tim mạch. Cụ thể, khi các yếu tố khác không đổi, những người tăng huyết áp có nguy cơ mắc bệnh tim mạch gấp 3.196 lần so với người không mắc.

  • Hệ số của biến BTĐ = 0.984, tức: \[OR = e^{0.984} \approx 2.675 > 1\] cho thấy người mắc bệnh tiểu đường sẽ làm tăng tỷ lệ mắc bệnh tim mạch. Cụ thể, khi các yếu tố khác không đổi, những người mắc bệnh tiểu đường có nguy cơ mắc bệnh tim mạch cao hơn 2.675 lần so với người không mắc.

  • Hệ số của biến T = 0.0111 tức: \[OR = e^{0.0111} \approx 1.0111 > 1\] cho thấy thêm một năm tuổi sẽ làm tăng nguy cơ mắc bệnh tim mạch lên 1.011 lần. Với điều kiện các yếu tố khác không đổi, nguy cơ mắc bệnh tim tăng 1.1% khi người mắc bệnh lớn hơn một tuổi.

  • Hệ số của biến VĐ = 0.219, tức: \[OR = e^{0.219} \approx 1.245 > 1\] cho thấy người không vận động cũng sẽ làm tăng tỷ lệ mắc bệnh tim mạch. Cụ thể, khi các yếu tố khác không đổi, những người không vận động có nguy cơ mắc bệnh tim mạch cao hơn 1.245 lần so với người có vận động thường xuyên.

2. Hồi quy Probit

Tương tự, nhằm phân tích xác suất Bệnh tim mạch(mắc bênh = 1, không mắc bệnh = 0) dựa trên các biến độc lặp, nhưng dựa trên hồi quy probit.

data$"Bệnh tim mạch" <- factor(data$"Bệnh tim mạch", levels = c('Không mắc bệnh','Mắc bệnh'))
regprobit <- glm(`Bệnh tim mạch` ~ `Tăng huyết áp` + `Bệnh tiểu đường` + `Tuổi` + `Vận động thường xuyên` + `Chỉ số BMI`, data = data, family = binomial(link = 'probit')) 
summary(regprobit)
## 
## Call:
## glm(formula = `Bệnh tim mạch` ~ `Tăng huyết áp` + `Bệnh tiểu đường` + 
##     Tuổi + `Vận động thường xuyên` + `Chỉ số BMI`, 
##     family = binomial(link = "probit"), data = data)
## 
## Coefficients:
##                                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           -2.047753   0.181375 -11.290  < 2e-16 ***
## `Tăng huyết áp`Mắc bệnh                0.583411   0.053485  10.908  < 2e-16 ***
## `Bệnh tiểu đường`Mắc bệnh              0.497527   0.058012   8.576  < 2e-16 ***
## Tuổi                                   0.005154   0.001502   3.432 0.000599 ***
## `Vận động thường xuyên`Không vận động  0.105762   0.045332   2.333 0.019645 *  
## `Chỉ số BMI`                          -0.002359   0.006369  -0.370 0.711158    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3839.3  on 9151  degrees of freedom
## Residual deviance: 3618.1  on 9146  degrees of freedom
## AIC: 3630.1
## 
## Number of Fisher Scoring iterations: 6

Mô hình Probit có dạng:

      \(\hat\pi\) = \(\phi\)( -2.047753 + 0.583411THA + 0.497527BTĐ + 0.005154T + 0.105762VĐ - 0.002359BMI)

Nhận xét:

  • Dựa vào kết quả p - value < 0.05 của tất cả biến giải thích được đưa vào mô hình, điều này cho thấy đây là các biến có ý nghĩa thống kê và ảnh hưởng đến xác suất mắc bệnh tim mạch. Tuy nhiên Chỉ số BMI với p-value = 0.779 > 0.05, tức không có ý nghĩa trong mô hình này.

  • Hệ số của biến THA = 0.583, tức người mắc bệnh tăng huyết áp làm tăng khả năng mắc bệnh tim mạch.

  • Hệ số của biến BTĐ = 0.498, cho thấy người mắc bệnh tiểu đường làm tăng khả năng mắc bệnh tim mạch.

  • Hệ số của biến T = 0.005, cho thấy số tuổi tăng thêm mỗi năm làm tăng khả năng mắc bệnh tim mạch

  • Hệ số của biến Vận động thường xuyên = 0.106 cho thấy việc không vận động cũng làm tăng nguy cơ mắc bệnh.