Bài tiểu luận cuối kì
Nguyễn Thị Mỹ Linh
2023-08-01
LỜI MỞ ĐẦU
Lí do chọn đề tài
Khoảng 85% các trường hợp đột quỵ là do tắc nghẽn động mạch não gây ra bởi cục máu đông, làm máu ngừng lưu thông dẫn đến cơn đột quỵ do thiếu máu cục bộ. Nguyên nhân chính là sự tích tụ của các chất lắng đọng cholesterol trên thành mạch làm thu hẹp đường kính của động mạch và thúc đẩy sự tắc nghẽn. Sự thu hẹp này, được gọi là xơ vữa động mạch, đôi khi khu trú trong não nhưng cũng có thể xảy ra trường hợp một mảnh cholesterol lắng đọng, hiện diện bên ngoài, tách ra và di chuyển qua dòng máu vào động mạch não.Trong 15% trường hợp còn lại là xuất huyết, nghĩa là do vỡ động mạch não, suy yếu bởi sự tăng huyết áp (nguyên nhân chính), dị tật, các khối u và các rối loạn chảy máu khác nhau. Đột quỵ xuất huyết là do chảy máu trong não hoặc dưới màng não (màng não) xảy ra sau khi mạch máu bị vỡ. Xuất huyết não có thể do huyết áp cao không kiểm soát được hoặc trong một số trường hợp có liên quan đến những bất thường trong cấu trúc mạch máu gọi là chứng phình động mạch. Đây là những biến dạng của động mạch tạo thành một túi nhỏ có thành mỏng manh cuối cùng sẽ gây ra “vỡ phình động mạch”.Trong một cơn đột quỵ do thiếu máu cục bộ, các tế bào, đặc biệt là các tế bào thần kinh của vùng não bị ảnh hưởng ở trong tình trạng thiếu oxy, nghĩa là chúng không còn nhận đủ oxy và đường cần thiết cho sự sống (thường được cung cấp bởi dòng máu). Khi tình trạng này kéo dài, các tế bào sẽ chết làm mất các chức năng của não liên quan đến các vùng bị ảnh hưởng.
MỤC TIÊU NGHIÊN CỨU
Làm rõ cơ sở lý luận, thực tiễn của hoạt động nghiên cứu rủi ro tới nguy cơ bị đột quỵ Đo lường mức độ ảnh hưởng của đột quỵ tới con người
ĐỐI TƯỢNG NGHIÊN CỨU
Các nguyên nhân gây ra đột quỵ
CHƯƠNG 1 : GIỚI THIỆU VỀ DỮ LIỆU
Theo Tổ chức Y tế Thế giới (WHO) đột quỵ là nguyên nhân gây tử vong đứng thứ 2 trên toàn cầu, chiếm khoảng 11% tổng số ca tử vong.Bộ dữ liệu này được sử dụng để dự đoán liệu một bệnh nhân có khả năng bị đột quỵ hay không dựa trên các thông số đầu vào như giới tính, tuổi tác, các bệnh khác nhau và tình trạng hút thuốc. Mỗi hàng trong dữ liệu cung cấp thông tin liên quan về bệnh nhân. Bộ dữ liệu nghiên cứu bao gồm 2699 quan sát với 12 biến bao gồm 7 biến định lượng và 5 biến định tính.
id: định danh duy nhất
gender( Giớitính): “Nam”, “Nữ”
age: tuổi của bệnh nhân
hypertension: 0 nếu bệnh nhân không tăng huyết áp, 1 nếu bệnh nhân tăng huyết áp
heart_disease: 0 nếu bệnh nhân không mắc bệnh tim, 1 nếu bệnh nhân mắc bệnh tim
ever_married( đã có gia đình): “No” hoặc “Yes”
work_type(Công việc): “children”, “Govt_jov”, “Never_worked”, “Tư nhân” hoặc “Tự kinh doanh”
Residence_type( Khu vực sinh sống): “Nông thôn” hoặc “Thành thị”
avg_glucose_level: mức đường huyết trung bình
bmi: chỉ số khối cơ thể
smoking_status: “đã từng hút thuốc”, “chưa bao giờ hút thuốc”,“smokes” hoặc “Unknown”*
stroke: 1 nếu bệnh nhân bị đột quỵ hoặc 0 nếu không
setwd("C:/Users/LENOVO/Desktop")
D <- read.csv("ĐQ.csv")
str(D)## 'data.frame': 2699 obs. of 12 variables:
## $ id : int 9046 51676 31112 60182 1665 56669 53882 10434 27419 60491 ...
## $ gender : chr "Male" "Female" "Male" "Female" ...
## $ age : num 67 61 80 49 79 81 74 69 59 78 ...
## $ hypertension : int 0 0 0 0 1 0 1 0 0 0 ...
## $ heart_disease : int 1 0 1 0 0 0 1 0 0 0 ...
## $ ever_married : chr "Yes" "Yes" "Yes" "Yes" ...
## $ work_type : chr "Private" "Self-employed" "Private" "Private" ...
## $ Residence_type : chr "Urban" "Rural" "Rural" "Urban" ...
## $ avg_glucose_level: num 229 202 106 171 174 ...
## $ bmi : chr "36.6" "N/A" "32.5" "34.4" ...
## $ smoking_status : chr "formerly smoked" "never smoked" "never smoked" "smokes" ...
## $ stroke : int 1 1 1 1 1 1 1 1 1 1 ...summary(D)## id gender age hypertension
## Min. : 77 Length:2699 Min. : 0.08 Min. :0.0000
## 1st Qu.:17504 Class :character 1st Qu.:26.50 1st Qu.:0.0000
## Median :36486 Mode :character Median :47.00 Median :0.0000
## Mean :36357 Mean :44.67 Mean :0.1074
## 3rd Qu.:54632 3rd Qu.:63.00 3rd Qu.:0.0000
## Max. :72918 Max. :82.00 Max. :1.0000
## heart_disease ever_married work_type Residence_type
## Min. :0.00000 Length:2699 Length:2699 Length:2699
## 1st Qu.:0.00000 Class :character Class :character Class :character
## Median :0.00000 Mode :character Mode :character Mode :character
## Mean :0.06336
## 3rd Qu.:0.00000
## Max. :1.00000
## avg_glucose_level bmi smoking_status stroke
## Min. : 55.22 Length:2699 Length:2699 Min. :0.00000
## 1st Qu.: 77.96 Class :character Class :character 1st Qu.:0.00000
## Median : 93.14 Mode :character Mode :character Median :0.00000
## Mean :108.71 Mean :0.09226
## 3rd Qu.:117.72 3rd Qu.:0.00000
## Max. :271.74 Max. :1.00000library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.1library(DT)## Warning: package 'DT' was built under R version 4.3.1library(dplyr)## Warning: package 'dplyr' was built under R version 4.3.1##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondatatable(D)summary(D)## id gender age hypertension
## Min. : 77 Length:2699 Min. : 0.08 Min. :0.0000
## 1st Qu.:17504 Class :character 1st Qu.:26.50 1st Qu.:0.0000
## Median :36486 Mode :character Median :47.00 Median :0.0000
## Mean :36357 Mean :44.67 Mean :0.1074
## 3rd Qu.:54632 3rd Qu.:63.00 3rd Qu.:0.0000
## Max. :72918 Max. :82.00 Max. :1.0000
## heart_disease ever_married work_type Residence_type
## Min. :0.00000 Length:2699 Length:2699 Length:2699
## 1st Qu.:0.00000 Class :character Class :character Class :character
## Median :0.00000 Mode :character Mode :character Mode :character
## Mean :0.06336
## 3rd Qu.:0.00000
## Max. :1.00000
## avg_glucose_level bmi smoking_status stroke
## Min. : 55.22 Length:2699 Length:2699 Min. :0.00000
## 1st Qu.: 77.96 Class :character Class :character 1st Qu.:0.00000
## Median : 93.14 Mode :character Mode :character Median :0.00000
## Mean :108.71 Mean :0.09226
## 3rd Qu.:117.72 3rd Qu.:0.00000
## Max. :271.74 Max. :1.00000View(D)Chọn biến định lượng làm biến phụ thuộc
Đối với biến định tính tôi chọn biến smoking_status làm biến phu thuộc Tôi chọn biến tính smoking_status làm biến phụ thuộc, với lý do tôi muốn biết hút thuốc có gây ra nguy cơ đột quỵ ở con người hay không, qua đó đánh giá được những tiềm ẩn gây hại mà hút thuốc gây ra
Chọn biến định lượng làm biến phụ thuộc
Đối với biến địnhlượng tôi chọn biến heart_disease làm biến phu thuộc.
CHƯƠNG 2.THỐNG KÊ MÔ TẢ
2.1 THỐNG KÊ MÔ TẢ CHO TỪNG BIẾN
2.1.1 Biến Gender
table(D$gender)##
## Female Male
## 1558 1141table(D$gender)/sum(table(D$gender))##
## Female Male
## 0.5772508 0.4227492library(ggplot2)
D |> ggplot(aes(x = gender, y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = 'gender', y = 'Number of passenger')
Nhận xét: Trong 2699 người thì có: 1558 người là nữ 1141 người là nam
2.1.2 Biến heart_disease
table(D$heart_disease)##
## 0 1
## 2528 171table(D$ heart_disease )/sum(table(D$heart_disease))##
## 0 1
## 0.9366432 0.0633568library(ggplot2)
D |> ggplot(aes(x =heart_disease, y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = 'heart_disease', y = 'Number of passenger')
Nhận xét: Tổng số người khảo sát là 2699 người trong đó số bệnh nhân không mắc bệnh tim làm2528 người chiếm 94%, số người mắc bệnh tim là 171 người chiếm 6%
2.1.3 Biến Residence_type
table(D$ Residence_type )##
## Rural Urban
## 1342 1357table(D$ Residence_type )/sum(table(D$ Residence_type ))##
## Rural Urban
## 0.4972212 0.5027788library(ggplot2)
D |> ggplot(aes(x = Residence_type , y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = ' Residence_type ', y = 'Number of passenger')
Nhận xét: Tổng số người khảo sát là 2699 người trong đó có 1342 người ở nông thôn và 1357 người ở thành thị
2.1.4 Biến stroke
table(D$stroke )##
## 0 1
## 2450 249table(D$stroke )/sum(table(D$ stroke ))##
## 0 1
## 0.90774361 0.09225639D |> ggplot(aes(x =stroke, y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = 'stroke', y = 'Number of passenger')
Nhận xét: Trong tổng số 2699 người khảo sát thì có 2450 người không măc bệnh (chiếm 91%) và có 249 người mắc bệnh ( chiếm 9%)
2.1.5 Biến smoking_status
table(D$smoking_status )##
## formerly smoked never smoked smokes Unknown
## 473 999 433 794table(D$smoking_status )/sum(table(D$smoking_status))##
## formerly smoked never smoked smokes Unknown
## 0.1752501 0.3701371 0.1604298 0.2941830D |> ggplot(aes(x =smoking_status, y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = 'smoking_status', y = 'Number of passenger')
Nhận xét: Trong 2699 người thì có 473 ngườitrước đây đã hút thuốc, có 999 người không bao giờ hút thuốc,433 người hút thuốc và 794 người chưa có thông tin
2.1.6 Biến hypertension
table(D$hypertension )##
## 0 1
## 2409 290table(D$hypertension )/sum(table(D$hypertension ))##
## 0 1
## 0.8925528 0.1074472D |> ggplot(aes(x =heart_disease, y = after_stat(count))) +
geom_bar(fill = 'pink') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
theme_classic() +
labs(x = 'hypertension ', y = 'Number of passenger')
Nhận xét: Trong tổng số 2699 người khảo sát thì có 2409 người không không tăng huyết áp (chiếm 94%) và có 290 người tăng huyết áp
##2.2 Bảng thống kê mô tả 2 biến
cpp <- table(D$smoking_status, D$heart_disease)
cpp <- prop.table(cpp)
addmargins(cpp)##
## 0 1 Sum
## formerly smoked 0.15672471 0.01852538 0.17525009
## never smoked 0.35050019 0.01963690 0.37013709
## smokes 0.14672101 0.01370878 0.16042979
## Unknown 0.28269730 0.01148574 0.29418303
## Sum 0.93664320 0.06335680 1.00000000Nhận xét
2.3 Rủi ro tương quan
library(DescTools)## Warning: package 'DescTools' was built under R version 4.3.1cpp <- table(D$smoking_status, D$heart_disease)
addmargins(cpp)##
## 0 1 Sum
## formerly smoked 423 50 473
## never smoked 946 53 999
## smokes 396 37 433
## Unknown 763 31 794
## Sum 2528 171 2699cpp <- table(D$smoking_status, D$heart_disease)
library(epitools)
riskratio(cpp,rev = 'c')## $data
##
## 1 0 Total
## formerly smoked 50 423 473
## never smoked 53 946 999
## smokes 37 396 433
## Unknown 31 763 794
## Total 171 2528 2699
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## formerly smoked 1.000000 NA NA
## never smoked 1.058879 1.0231914 1.095812
## smokes 1.022652 0.9803008 1.066834
## Unknown 1.074545 1.0386166 1.111717
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## formerly smoked NA NA NA
## never smoked 3.460793e-04 4.083183e-04 2.171506e-04
## smokes 3.042510e-01 3.119907e-01 3.012353e-01
## Unknown 4.837711e-06 4.662601e-06 2.707341e-06
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"Nhận xét ## 2.4 Thống kê mô tả 2 biến
2.4.1 Biến smoking_status và biến hypertension
cpp <- table(D$smoking_status, D$hypertension)
cpp##
## 0 1
## formerly smoked 408 65
## never smoked 856 143
## smokes 381 52
## Unknown 764 30chisq.test(cpp)##
## Pearson's Chi-squared test
##
## data: cpp
## X-squared = 58.606, df = 3, p-value = 1.167e-122.4.2 Biến smoking_status và biến heart_disease
cpp <- table(D$smoking_status, D$heart_disease)
cpp##
## 0 1
## formerly smoked 423 50
## never smoked 946 53
## smokes 396 37
## Unknown 763 31chisq.test(cpp)##
## Pearson's Chi-squared test
##
## data: cpp
## X-squared = 27.555, df = 3, p-value = 4.503e-062.4.3 Biến smoking_status và biến stroke
cpp <- table(D$stroke, D$smoking_status)
cpp##
## formerly smoked never smoked smokes Unknown
## 0 403 909 391 747
## 1 70 90 42 47chisq.test(cpp)##
## Pearson's Chi-squared test
##
## data: cpp
## X-squared = 28.082, df = 3, p-value = 3.492e-06CHƯƠNG 3 MÔ HÌNH HỒI QUI
3.1 MÔ HÌNH HỒI QUI LOGIT
fit1 <- glm(factor(smoking_status) ~ gender+age+hypertension+heart_disease+ever_married+work_type+stroke, family = binomial(link = 'logit'), data = D)
summary(fit1)##
## Call:
## glm(formula = factor(smoking_status) ~ gender + age + hypertension +
## heart_disease + ever_married + work_type + stroke, family = binomial(link = "logit"),
## data = D)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.187762 0.388403 10.782 < 2e-16 ***
## genderMale -0.323385 0.105927 -3.053 0.00227 **
## age -0.018475 0.003718 -4.969 6.74e-07 ***
## hypertension 0.153092 0.157713 0.971 0.33170
## heart_disease -0.079083 0.187892 -0.421 0.67383
## ever_marriedYes -0.446397 0.165887 -2.691 0.00712 **
## work_typeGovt_job -1.246183 0.443633 -2.809 0.00497 **
## work_typeNever_worked 10.902203 293.378588 0.037 0.97036
## work_typePrivate -1.287306 0.421251 -3.056 0.00224 **
## work_typeSelf-employed -1.410225 0.443934 -3.177 0.00149 **
## stroke -0.148234 0.163149 -0.909 0.36357
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2505.3 on 2698 degrees of freedom
## Residual deviance: 2317.5 on 2688 degrees of freedom
## AIC: 2339.5
##
## Number of Fisher Scoring iterations: 133.2 MÔ HÌNH HỒI QUI PROBIT
fit2 <- glm(factor(smoking_status) ~ gender+age+hypertension+heart_disease+ever_married+work_type+stroke, family = binomial(link = 'probit'), data = D)
summary(fit2)##
## Call:
## glm(formula = factor(smoking_status) ~ gender + age + hypertension +
## heart_disease + ever_married + work_type + stroke, family = binomial(link = "probit"),
## data = D)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.23118 0.16132 13.831 < 2e-16 ***
## genderMale -0.17902 0.06019 -2.974 0.00294 **
## age -0.01073 0.00211 -5.084 3.69e-07 ***
## hypertension 0.09102 0.09153 0.995 0.31998
## heart_disease -0.05130 0.11221 -0.457 0.64756
## ever_marriedYes -0.23271 0.08962 -2.596 0.00942 **
## work_typeGovt_job -0.52214 0.19898 -2.624 0.00869 **
## work_typeNever_worked 3.09899 78.03928 0.040 0.96832
## work_typePrivate -0.54322 0.18235 -2.979 0.00289 **
## work_typeSelf-employed -0.61612 0.19967 -3.086 0.00203 **
## stroke -0.08626 0.09692 -0.890 0.37348
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2505.3 on 2698 degrees of freedom
## Residual deviance: 2316.8 on 2688 degrees of freedom
## AIC: 2338.8
##
## Number of Fisher Scoring iterations: 133.3 MÔ hình cloglog
fit3 <- glm(factor(smoking_status) ~ gender+age+hypertension+heart_disease+ever_married+work_type+stroke, family = binomial(link = 'cloglog'), data = D)
summary(fit3)##
## Call:
## glm(formula = factor(smoking_status) ~ gender + age + hypertension +
## heart_disease + ever_married + work_type + stroke, family = binomial(link = "cloglog"),
## data = D)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.521007 0.103577 14.685 < 2e-16 ***
## genderMale -0.146230 0.051901 -2.817 0.00484 **
## age -0.009583 0.001835 -5.222 1.77e-07 ***
## hypertension 0.085997 0.081749 1.052 0.29282
## heart_disease -0.056963 0.106231 -0.536 0.59181
## ever_marriedYes -0.175945 0.073089 -2.407 0.01607 *
## work_typeGovt_job -0.315619 0.141044 -2.238 0.02524 *
## work_typeNever_worked 1.451313 22.732158 0.064 0.94909
## work_typePrivate -0.330355 0.122732 -2.692 0.00711 **
## work_typeSelf-employed -0.397868 0.142706 -2.788 0.00530 **
## stroke -0.078773 0.090588 -0.870 0.38453
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2505.3 on 2698 degrees of freedom
## Residual deviance: 2315.9 on 2688 degrees of freedom
## AIC: 2337.9
##
## Number of Fisher Scoring iterations: 123.4 MÔ HÌNH PHÙ HỢP
3.4.1 Akaike Information Criterion
aic1 <- AIC(fit1)
aic2 <- AIC(fit2)
aic3 <- AIC(fit3)
AIC <-cbind(aic1, aic2, aic3)
AIC## aic1 aic2 aic3
## [1,] 2339.511 2338.765 2337.894Giá trị của AIC càng nhỏ thì mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị AIC là nhỏ nhất (191,1709). Vì vậy mô hình Cloglog là tốt nhất.
3.4.2 Brier Score
library(DescTools)
BrierScore(fit1)## [1] 0.1358758library(DescTools)
BrierScore(fit2)## [1] 0.1358795library(DescTools)
BrierScore(fit3)## [1] 0.1358974Giá trị của Brier Score càng nhỏ nghĩa là chênh lệch giữa xác suất thực tế và xác suất tính từ mô hình càng nhỏ, nghĩa là mô hình càng tốt.