require(tidyverse)
## Loading required package: tidyverse
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.1 ✔ tibble 3.1.8
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
library(ggplot2)
library(readxl)
## Warning: package 'readxl' was built under R version 4.2.3
library(epitools)
library(DescTools)
## Warning: package 'DescTools' was built under R version 4.2.3
setwd("C:/PTDLDT1")
data <- read_excel("data.xlsx",1)
data
- Biến phụ thuộc định tính được chọn là biến hd (những người mắc bệnh tim)
mh1 <- glm(factor (hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "logit"), data = data)
summary(mh1)
##
## Call:
## glm(formula = factor(hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "logit"),
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1406 -0.4800 -0.4752 -0.3369 2.4072
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.8407 0.2369 -11.991 < 2e-16 ***
## data$skYes 0.7165 0.2488 2.880 0.00398 **
## data$dwYes 1.2993 0.2506 5.184 2.17e-07 ***
## data$diaYes 0.7376 0.2604 2.833 0.00461 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 488.14 on 583 degrees of freedom
## Residual deviance: 435.79 on 580 degrees of freedom
## AIC: 443.79
##
## Number of Fisher Scoring iterations: 5
Vậy nên mô hình logit được xác định như sau:
\[ logit(π) = log(π/1−π) = -0,8407 + 0,7165sk + 1,2993dw + 0,7376dia\]
mh2 <- glm(factor (hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "probit"),data = data)
summary(mh2)
##
## Call:
## glm(formula = factor(hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "probit"),
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1088 -0.4887 -0.4817 -0.3286 2.4272
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.6205 0.1191 -13.610 < 2e-16 ***
## data$skYes 0.3914 0.1350 2.900 0.00373 **
## data$dwYes 0.7191 0.1398 5.145 2.68e-07 ***
## data$diaYes 0.4075 0.1469 2.773 0.00555 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 488.14 on 583 degrees of freedom
## Residual deviance: 436.05 on 580 degrees of freedom
## AIC: 444.05
##
## Number of Fisher Scoring iterations: 5
Sau khi chạy mô hình probit ta có hàm hồi quy sau:
\[probit(π) = Φ^(-1)(π) = -1,6205 + 0,3914sk + 0,7191dw + 0,4075dia\]
mh3 <- glm(factor (hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "cloglog"),data = data)
summary(mh3)
##
## Call:
## glm(formula = factor(hd) ~ data$sk + data$dw + data$dia, family = binomial(link = "cloglog"),
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1726 -0.4762 -0.4721 -0.3439 2.3907
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.8282 0.2180 -12.974 < 2e-16 ***
## data$skYes 0.6337 0.2208 2.870 0.00410 **
## data$dwYes 1.1683 0.2239 5.218 1.81e-07 ***
## data$diaYes 0.6514 0.2259 2.884 0.00393 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 488.14 on 583 degrees of freedom
## Residual deviance: 435.66 on 580 degrees of freedom
## AIC: 443.66
##
## Number of Fisher Scoring iterations: 5
Sau khi chạy mô hình cloglog ta có hàm hồi quy sau:
\[cloglog(π)=log(−log(1−π)) = -2,8282 + 0,6337sk + 1,1683dw + 0,6514dia\]
AIC(mh1)
## [1] 443.786
AIC(mh2)
## [1] 444.0484
AIC(mh3)
## [1] 443.6562
Từ chỉ số AIC của 3 mô hình trên ta thấy mô hình cloglog có chỉ số AIC thấp nhất (443,6562). Vì thế đối với tiêu chí đánh giá AIC thì mô hình cloglog là phù hợp để xem xét sự tác động của các yếu tố đến biến phụ thuộc hd hơn mô hình probit và logit.
deviance(mh1)
## [1] 435.786
deviance(mh2)
## [1] 436.0484
deviance(mh3)
## [1] 435.6562
Từ chỉ số deviance của 3 mô hình trên ta thấy mô hình cloglog có chỉ số deviance thấp nhất (435,6562). Vì thế đối với tiêu chí đánh giá devience thì mô hình cloglog là phù hợp để xem xét sự tác động của các yếu tố đến biến phụ thuộc hd hơn mô hình probit và logit.
BrierScore(mh1)
## [1] 0.1125801
BrierScore(mh2)
## [1] 0.1126808
BrierScore(mh3)
## [1] 0.1125252
Từ chỉ số BrierScore của 3 mô hình trên ta thấy mô hình cloglog có chỉ số BrierScore thấp nhất (0,1125252). Vì thế đối với tiêu chí đánh giá BrierScore thì mô hình cloglog là phù hợp để xem xét sự tác động của các yếu tố đến biến phụ thuộc hd hơn mô hình probit và logit.
Thông qua các tiêu chí đánh giá mô hình AIC, Deviance và BrierScore thì mô hình phù hợp nhất để xem xét tác động của các yếu tố hút thuốc lá, triệu chứng gặp khó khăn khi leo cầu thang và bệnh tiểu đường tới biến phụ thuộc hd (mắc bệnh tim) là mô hình hồi quy cloglog
Làm thống kê mô tả cho ít nhất 5 biến (vừa định tính vừa định lượng và 2 biến đã chọn ở câu 2), nhận xét về kết quả phân tích này
Mã hóa biến bmi từ biến định lượng sang biến định tính
bmi1 <- data$bmi
bmi1 <- cut(data$bmi, breaks = c(0,29.00,75.82), labels=c("dưới 29.00","trên 29.00"))
table(bmi1)
## bmi1
## dưới 29.00 trên 29.00
## 338 246
table(bmi1)/sum(table(bmi1))
## bmi1
## dưới 29.00 trên 29.00
## 0.5787671 0.4212329
data |> ggplot(aes(x = bmi1, y = after_stat(count))) + geom_bar(fill = 'lavender') + geom_text(aes(label=scales::percent(after_stat(count/sum(count)), accuracy= 0.01)), stat = 'count', color = 'black', vjust = -0.5)+ theme_classic() + xlab('BMI') + ylab('Số người')
Dựa vào biểu đồ ta thấy được có 246 người có chỉ số bmi trên 29.00 (chiếm 42,12%), 338 người có chỉ số bmi dưới 29.00 (chiếm 57,87%)
table(data$hd)
##
## No Yes
## 498 86
table(data$hd)/sum(table(data$hd))
##
## No Yes
## 0.8527397 0.1472603
data |> ggplot(aes(x = hd, y = after_stat(count))) + geom_bar(fill = 'green') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'bệnh tim', y = 'Số người')
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy số người mắc bệnh liên quan đến tim mạch và những người không mắc bệnh chênh lệch nhau rất nhiều, cụ thể trong đó những người mắc bệnh về tim mạch chiếm 15% và những người không mắc bệnh chiếm 85%.
table(data$ad)
##
## No Yes
## 560 24
table(data$ad)/sum(table(data$ad))
##
## No Yes
## 0.95890411 0.04109589
data |> ggplot(aes(x = ad, y = after_stat(count))) + geom_bar(fill = 'brown') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'darkgreen', vjust = - .5) + theme_classic() + labs(x = 'Nghiện rượu', y = 'Số người') + coord_flip()
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong tổng số 548 người thì những người nghiện rượu là 24 người (chiếm 4%) và những người không nghiện rượu là 560 người (chiếm 96%).
table(data$sk)
##
## No Yes
## 328 256
table(data$sk)/sum(table(data$sk))
##
## No Yes
## 0.5616438 0.4383562
data |> ggplot(aes(x = sk, y = after_stat(count))) + geom_bar(fill = 'green') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Hút thuốc lá', y = 'Số người') + coord_flip()
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong tổng số 548 người thì những người sử dụng thuốc lá chiếm 44% và những người không sử dụng thuốc lá chiếm 56%.
table(data$agec)
##
## 18-24 25-29 30-34 35-39 40-44 45-49
## 3 2 2 7 14 19
## 50-54 55-59 60-64 65-69 70-74 75-79
## 31 35 63 103 108 92
## 80 or older
## 105
table(data$agec)/sum(table(data$agec))
##
## 18-24 25-29 30-34 35-39 40-44 45-49
## 0.005136986 0.003424658 0.003424658 0.011986301 0.023972603 0.032534247
## 50-54 55-59 60-64 65-69 70-74 75-79
## 0.053082192 0.059931507 0.107876712 0.176369863 0.184931507 0.157534247
## 80 or older
## 0.179794521
data |> ggplot(aes(x = agec, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Hút thuốc lá', y = 'Số người') + coord_flip()
Dựa vào kết quả phân tích ta thấy những người mắc các căn bệnh liên quan đến tim mạch trong độ tuổi 70-74 tuổi chiếm cao nhất với 18,49%. Xếp thứ hai là những người trong độ tuổi từ 80 tuổi trở lên sẽ mắc các bệnh liên quan đến tim mạch chiếm 17,98%. Và những người trong độ tuổi từ 25-34 tuổi sẽ ít mắc các căn bệnh liên quan đến tim mạch với 0,34%.
table(data$sex)
##
## F M
## 396 188
table(data$sex)/sum(table(data$sex))
##
## F M
## 0.6780822 0.3219178
pie(table(data$sex), col = rainbow(3), main = "Biểu đồ")
Dựa vào kết quả phân tích ta thấy những người có giới tính Nữ mắc những bệnh về tim mạch chiếm tỉ lệ nhiều hơn giới tính Nam với tỉ lệ lần lượt là 67,8% và 32,19%.
table(data$dw)
##
## No Yes
## 424 160
table(data$dw)/sum(table(data$dw))
##
## No Yes
## 0.7260274 0.2739726
data |> ggplot(aes(x = dw, y = after_stat(count))) + geom_bar(fill = 'lavender') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Gặp khó khăn leo cầu thang', y = 'Số người') + coord_flip()
Dựa vào kết quả phân tích ta thấy trong số 584 người thì có 160 người gặp khó khăn khi leo cầu thang (chiểm 27,39%) và 424 người không gặp khó khăn khi leo cầu thang (chiểm 72,6%)
table(data$dia)
##
## No Yes
## 443 141
table(data$dia)/sum(table(data$dia))
##
## No Yes
## 0.7585616 0.2414384
data |> ggplot(aes(x = dia, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Bệnh tiểu đường', y = 'Số người') + coord_flip()
Dựa vào kết quả phân tích ta thấy trong số 584 người thì có 24% là mắc bệnh tiểu đường và 76% không mắc bệnh tiểu đường
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và sex độc lập
H1: Hai biến hd và sex không độc lập
chisq.test(table(data$hd,data$sex))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, data$sex)
## X-squared = 1.4483, df = 1, p-value = 0.2288
Tại mức ý nghĩa 5%, với p-vlue > 0,05 thì ta đủ cơ sở chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và giới tính là độc lập với nhau
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và bmi độc lập
H1: Hai biến hd và bmi không độc lập
chisq.test(table(data$hd,bmi1))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, bmi1)
## X-squared = 0.090778, df = 1, p-value = 0.7632
Tại mức ý nghĩa 5%, với p-vlue > 0,05 thì ta đủ cơ sở chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và bmi là độc lập với nhau
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và sk độc lập
H1: Hai biến hd và sk không độc lập
chisq.test(table(data$hd,data$sk))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, data$sk)
## X-squared = 9.0763, df = 1, p-value = 0.002589
Tại mức ý nghĩa 5%, với p-vlue < 0,05 thì ta chưa đủ cơ sở để chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và hút thuốc là không độc lập
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và ad độc lập
H1: Hai biến hd và ad không độc lập
chisq.test(table(data$hd,data$ad))
## Warning in chisq.test(table(data$hd, data$ad)): Chi-squared approximation may
## be incorrect
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, data$ad)
## X-squared = 0.37013, df = 1, p-value = 0.5429
Tại mức ý nghĩa 5%, với p-vlue > 0,05 thì ta chưa đủ cơ sở để chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và nghiện rượu là độc lập
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và dw độc lập
H1: Hai biến hd và dw không độc lập
chisq.test(table(data$hd,data$dw))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, data$dw)
## X-squared = 39.284, df = 1, p-value = 3.665e-10
Tại mức ý nghĩa 5%, với p-vlue < 0,05 thì ta chưa đủ cơ sở để chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và gặp khó khăn leo cầu thang là không độc lập
Cặp giả thuyết/ đối thuyết
H0: Hai biến hd và dia độc lập
H1: Hai biến hd và dia không độc lập
chisq.test(table(data$hd,data$dia))
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(data$hd, data$dia)
## X-squared = 16.168, df = 1, p-value = 5.796e-05
Tại mức ý nghĩa 5%, với p-vlue < 0,05 thì ta chưa đủ cơ sở để chấp nhận H0, nghĩa là việc những người mắc căn bệnh về tim mạch và bệnh tiểu đường là không độc lập với nhau.
gt <-table(data$sex,data$hd)
gt
##
## No Yes
## F 343 53
## M 155 33
ggplot(data, aes(sex, fill = hd)) + geom_bar(position = 'dodge')
RelRisk(gt)
## [1] 1.05057
library(epitools)
riskratio(gt)
## $data
##
## No Yes Total
## F 343 53 396
## M 155 33 188
## Total 498 86 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## F 1.000000 NA NA
## M 1.311521 0.8805119 1.95351
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## F NA NA NA
## M 0.1895993 0.2112477 0.1840371
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người có mắc bệnh tim theo giới tính là 1,3115 tức là tỷ lệ rủi ro những người nam mắc các bệnh về tim mạch gấp 1,311 lần tỷ lệ những người nữ mắc bệnhtim mạch
riskratio(gt, rev = "c")
## $data
##
## Yes No Total
## F 53 343 396
## M 33 155 188
## Total 86 498 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## F 1.000000 NA NA
## M 0.951864 0.8817793 1.027519
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## F NA NA NA
## M 0.1895993 0.2112477 0.1840371
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người có mắc bệnh tim theo giới tính là 0,9518 tức là tỷ lệ những người mắc bệnh tim là nam ít hơn và tỷ lệ những người mắc bệnh tim là nữ
epitab(gt, method = 'oddsratio', rev='c')
## $tab
##
## Yes p0 No p1 oddsratio lower upper p.value
## F 53 0.6162791 343 0.688755 1.0000000 NA NA NA
## M 33 0.3837209 155 0.311245 0.7257708 0.4517045 1.166124 0.2112477
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ chênh là 0,725 tức là tỷ lệ những người có mắc bệnh tim/ những người không mắc bệnh tim ở giới tính nam chỉ bằng 72,57% tỷ lệ nhữung người có mắc bệnh tim/những người không mắc bệnh tim ở giưới tính nữ
bmi2 <-table(bmi1,data$hd)
bmi2
##
## bmi1 No Yes
## dưới 29.00 290 48
## trên 29.00 208 38
RelRisk(bmi2)
## [1] 1.014736
epitab (bmi2, method = 'riskratio', rev = "c")
## $tab
##
## bmi1 Yes p0 No p1 riskratio lower upper p.value
## dưới 29.00 48 0.1420118 290 0.8579882 1.000000 NA NA NA
## trên 29.00 38 0.1544715 208 0.8455285 0.985478 0.919953 1.05567 0.7231543
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người mắc bệnh tim theo chỉ số bmi là 0,985478 tỷ lệ rủi ro tương đối của những người có bmi trên 29.00 không mắc bệnh tim thấp hơn những người có bmi dưới 29.00 không mắc bệnh tim
Tỷ lệ chênh
epitab(bmi2, method = 'oddsratio', rev='c')
## $tab
##
## bmi1 Yes p0 No p1 oddsratio lower upper p.value
## dưới 29.00 48 0.5581395 290 0.5823293 1.0000000 NA NA NA
## trên 29.00 38 0.4418605 208 0.4176707 0.9059891 0.5711691 1.437081 0.7231543
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ chênh là 0,9059891 tức là tỷ lệ những người có bmi trên 29.00/dưới 29.00 mắc bệnh tim bằng 90.59% tỷ lệ những người bmi trên 29.00/dưới 29.00 không mắc bệnh tim.
sk <-table(data$sk,data$hd)
sk
##
## No Yes
## No 293 35
## Yes 205 51
ggplot(data, aes(sk, fill = hd)) + geom_bar(position = 'dodge')
RelRisk(sk)
## [1] 1.115526
riskratio(sk)
## $data
##
## No Yes Total
## No 293 35 328
## Yes 205 51 256
## Total 498 86 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.000000 NA NA
## Yes 1.866964 1.254036 2.779469
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 0.001941744 0.002132283 0.001745898
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người có mắc bệnh tim có liên quan đến việc hút thuốc là 1,8669 tức là tỷ lệ những người có hút thuốc mắc các bệnh về tim mạch gấp 1,866 lần tỷ lệ những người không hút thuốc mắc bệnh tim mạch
riskratio(sk, rev = "c")
## $data
##
## Yes No Total
## No 35 293 328
## Yes 51 205 256
## Total 86 498 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.0000000 NA NA
## Yes 0.8964377 0.8344642 0.9630138
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 0.001941744 0.002132283 0.001745898
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
epitab(sk, method = 'oddsratio', rev='c')
## $tab
##
## Yes p0 No p1 oddsratio lower upper p.value
## No 35 0.4069767 293 0.5883534 1.0000000 NA NA NA
## Yes 51 0.5930233 205 0.4116466 0.4801579 0.3013762 0.7649961 0.002132283
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ chênh là 0,48 tức là tỷ lệ những người có mắc bệnh tim/ những người không mắc bệnh tim ở những người không hút thuốc bằng 48,01% tỷ lệ những người có mắc bệnh tim/những người không mắc bệnh tim ở những người hút thuốc
lct <-table(data$dw,data$hd)
lct
##
## No Yes
## No 386 38
## Yes 112 48
RelRisk(lct)
## [1] 1.300539
epitab (lct, method = 'riskratio', rev = "c")
## $tab
##
## Yes p0 No p1 riskratio lower upper p.value
## No 38 0.08962264 386 0.9103774 1.0000000 NA NA NA
## Yes 48 0.30000000 112 0.7000000 0.7689119 0.6917562 0.8546733 2.13209e-09
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người mắc bệnh tim theo triệu chứng gặp khó khăn khi leo cầu thang là 0,7689119 tỷ lệ rủi ro tương đối của những người gặp khó khăn khi leo cầu thang không mắc bệnh tim thấp hơn những người không gặp khó khăn khi leo cầu thang không mắc bệnh tim
Tỷ lệ chênh
epitab(lct, method = 'oddsratio', rev='c')
## $tab
##
## Yes p0 No p1 oddsratio lower upper p.value
## No 38 0.4418605 386 0.7751004 1.0000000 NA NA NA
## Yes 48 0.5581395 112 0.2248996 0.2297064 0.142889 0.3692728 2.13209e-09
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ chênh là 0,2297064 tức là tỷ lệ những người gặp khó khăn leo cầu thang/không gặp khó khăn leo cầu thang mắc bệnh tim bằng 22,97% tỷ lệ những người gặp khó khăn leo cầu thang/không gặp khó khăn leo cầu thang không mắc bệnh tim.
td <-table(data$dia,data$hd)
td
##
## No Yes
## No 393 50
## Yes 105 36
RelRisk(td)
## [1] 1.191293
riskratio(td)
## $data
##
## No Yes Total
## No 393 50 443
## Yes 105 36 141
## Total 498 86 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.000000 NA NA
## Yes 2.262128 1.540476 3.321844
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 8.202272e-05 0.0001023787 3.218672e-05
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người có mắc bệnh tim có liên quan đến bệnh tiểu đường là 2,262 tức là tỷ lệ những người có bệnh tiểu đường mắc các bệnh về tim mạch gấp 2,262 lần tỷ lệ những người không bị bệnh tiểu đường nhưng mắc bệnh tim mạch
riskratio(td, rev = "c")
## $data
##
## Yes No Total
## No 50 393 443
## Yes 36 105 141
## Total 86 498 584
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.000000 NA NA
## Yes 0.839424 0.7578755 0.9297471
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 8.202272e-05 0.0001023787 3.218672e-05
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
epitab(td, method = 'oddsratio', rev='c')
## $tab
##
## Yes p0 No p1 oddsratio lower upper p.value
## No 50 0.5813953 393 0.7891566 1.0000000 NA NA NA
## Yes 36 0.4186047 105 0.2108434 0.3710772 0.229737 0.5993737 0.0001023787
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ chênh là 0,371 tức là tỷ lệ những người có mắc bệnh tim/ những người không mắc bệnh tim ở những người không bị bệnh tiểu đường bằng 37,1% tỷ lệ những người có mắc bệnh tim/những người không mắc bệnh tim ở những người bị bệnh tiểu đường
nr <-table(data$ad,data$hd)
nr
##
## No Yes
## No 476 84
## Yes 22 2
RelRisk(nr)
## [1] 0.9272727
epitab (nr, method = 'riskratio', rev = "c")
## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect
## $tab
##
## Yes p0 No p1 riskratio lower upper p.value
## No 84 0.15000000 476 0.8500000 1.000000 NA NA NA
## Yes 2 0.08333333 22 0.9166667 1.078431 0.9511939 1.222689 0.5573393
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Theo kết quả trên ta thấy tỷ lệ rủi ro tương đối của những người mắc bệnh tim với chứng nghiện rượu là 1,078431 tỷ lệ rủi ro tương đối của những người nghiện rượu không mắc bệnh tim thấp hơn những người không nghiện rượu không mắc bệnh tim
Tỷ lệ chênh
epitab(nr, method = 'oddsratio', rev='c')
## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect
## $tab
##
## Yes p0 No p1 oddsratio lower upper p.value
## No 84 0.97674419 476 0.95582329 1.000000 NA NA NA
## Yes 2 0.02325581 22 0.04417671 1.941176 0.4481168 8.408893 0.5573393
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
Chọn 1 hoặc 2 biến định tính và 1 biến định lượng để phân tích, giải thích lý do
Bài nghiên cứu chọn biến bmi là biến phụ thuộc vì tác giả muốn xem xét rằng liệu rằng những bệnh nhân mắc những căn bệnh như bệnh tim, tiểu đường, từng đột quỵ hay những bệnh nhân thường xuyên sử dụng thuốc lá, rượu sẽ ảnh hưởng đến chỉ số bmi như thế nào. Từ đó có những biện pháp cân bằng lại chế độ ăn uống lành mạnh để đạt được chỉ số bmi tốt.
Bài nghiên cứu chọn biến hd (bệnh nhân mắc bệnh tim mạch (yes/no)). Tại đây tác giả sẽ thông qua báo cáo của 584 bệnh nhân để biết được những yếu tố nào là nguyên nhân chính gây ra bệnh về tim. Từ đó có thể đưa ra giải pháp phòng ngừa bệnh tim mạch.
Bộ dữ liệu chứa thông tin 1 trong những nguyên nhân dẫn đến bệnh tim ở người.Theo CDC, bệnh tim là một trong những nguyên nhân gây tử vong hàng đầu cho những người thuộc hầu hết các chủng tộc ở Hoa Kỳ (Người Mỹ gốc Phi, người Mỹ da đỏ và thổ dân Alaska, và người da trắng). Khoảng một nửa số người Mỹ (47%) có ít nhất 1 trong 3 yếu tố nguy cơ chính gây bệnh tim: huyết áp cao, cholesterol cao và hút thuốc. Các chỉ số quan trọng khác bao gồm tình trạng tiểu đường, béo phì (chỉ số BMI cao), không hoạt động thể chất đầy đủ hoặc uống quá nhiều rượu
hd: (Heart disease) là những người được hỏi đã từng báo cáo mắc bệnh tim mạch vành (CHD) hoặc nhồi máu cơ tim (MI)
bmi: chỉ số khối cơ thể BMI
sk: (Smoking) là người đó có hút thuốc hay không (yes/no)
ad: (Alcohol drinking) là những người nghiện rượu nặng
stroke: là người đó đã từng đột quỵ chưa (yes/no)
ph: (PhycicalHealth) sức khỏe thể chất, bao gồm bệnh tật và chấn thương thể chất, trong 30 ngày qua sức khỏe thể chất không được tốt bao nhiêu ngày (0-30 ngày)
mh: (Mental health) sức khỏe tinh thần, có bao nhiêu ngày trong 30 ngày sức khỏe tinh thần không tốt (0-30 ngày)
dw:(Diff walking) người gặp khó khăn nghiêm trọng khi đi bộ hoặc leo cầu thang
sex: giới tính (M:nam/ F:nữ)
agec: độ tuổi
dia: (diabetic) người bị mắc bệnh tiểu đường (yes/no)
pa: (Physical activity) hoạt động thể chất. Người đó có hoạt động thể chất hoặc tập thể dục trong 30 ngày qua không (yes/no)
Dữ liệu này thu tập được gồm 584 quan sát, trong đó có tổng cộng 12 biến gồm 8 biến định tính và 3 biến định lượng
setwd("C:/PTDLDT1")
data <- read_excel("data.xlsx",1)
data