PTDLDT

1. Bài tập về nhà số 1

Cơn đau tim, còn được gọi là đau tim hay đau thắt ngực, là một triệu chứng thường gặp của các bệnh về tim mạch. Đây là một tình trạng y tế nghiêm trọng và cần được xử lý kịp thời để tránh các biến chứng nguy hiểm, bao gồm cả đau tim cấp tính và nhồi máu cơ tim.

Cơn đau tim thường xuất hiện khi lượng máu và oxy cung cấp cho cơ tim bị giảm, thường do tắc nghẽn các động mạch cung cấp máu tới tim. Nguyên nhân chính gây ra tắc nghẽn này là do sự tích tụ của chất béo, cholesterol và các tạp chất khác tạo thành các “bám dính” trên thành mạch máu, tạo thành các bệnh tổn thương gọi là plaques. Khi một plaque bị vỡ, huyết khối có thể hình thành và cản trở lưu thông máu tới một phần của cơ tim, gây ra cơn đau tim.

Triệu chứng cơn đau tim thường là một cảm giác nhức nhặt hoặc nặng nề ở phần trên của ngực, thường kéo dài từ vài phút đến một vài giờ. Cảm giác này có thể lan ra cả hai vai và cánh tay trái, cổ, hàm dưới và bụng. Cơn đau thường đi kèm với cảm giác khó thở, mệt mỏi, mồ hôi lạnh và buồn nôn.

Nếu bạn hoặc ai đó gặp phải triệu chứng của cơn đau tim, hãy liên hệ ngay với bác sĩ hoặc các dịch vụ y tế cấp cứu. Đau tim cấp tính có thể là dấu hiệu của cơn đau tim trước nhồi máu cơ tim, một tình trạng rất nguy hiểm có thể gây tử vong nếu không được chữa trị kịp thời.

Để hạn chế nguy cơ mắc bệnh tim mạch và cơn đau tim, hãy thực hiện các biện pháp phòng ngừa như hợp lý hóa chế độ ăn uống, tập luyện thường xuyên, kiểm soát cân nặng, tránh hút thuốc lá và uống rượu bia một cách có mức độ. Nếu bạn có bất kỳ yếu tố nguy cơ nào, hãy thảo luận với bác sĩ để được tư vấn và theo dõi sức khỏe tim mạch một cách thường xuyên.

https://www.kaggle.com/datasets/rashikrahmanpritom/heart-attack-analysis-prediction-dataset?resource=download

library(readxl)
heart <- read_excel("D:/heart.xlsx")
View(heart)

Age: Tuổi của bệnh nhân

Sex: Giới tính bệnh nhân

exang: đau thắt ngực do gắng sức (1 = có; 0 = không)

ca: số lượng tàu lớn (0-3)

cp: Loại đau ngực

Giá trị 1: đau thắt ngực điển hình

Giá trị 2: đau thắt ngực không điển hình

Giá trị 3: đau không đau thắt ngực

Giá trị 4: không có triệu chứng

trtbps: huyết áp khi nghỉ ngơi (tính bằng mm Hg)

chol: cholestoral tính bằng mg/dl được tải qua cảm biến BMI

fbs: (đường huyết lúc đói > 120 mg/dl) (1 = đúng; 0 = sai)

rest_ecg: kết quả điện tâm đồ khi nghỉ ngơi

Giá trị 0: bình thường

Giá trị 1: có bất thường sóng ST-T (sóng T đảo ngược và/hoặc ST chênh lên hoặc chênh xuống > 0,05 mV)

Giá trị 2: cho thấy phì đại thất trái có thể xảy ra hoặc xác định theo tiêu chí của Estes

thalach : nhịp tim tối đa đạt được

output: nguy cơ đau tim

0 ít nguy cơ

1 nhiều nguy cơ

2. Bài tập về nhà số 2

2.1 Chọn và giải thích biến định tính

sex: Giới tính bệnh nhân (1 nam 0 nữ)

fps: (đường huyết lúc đói > 120 mg/dl) (1 = đúng; 0 = sai)

rest_ecg: kết quả điện tâm đồ khi nghỉ ngơi

exng: đau thắt ngực do gắng sức (1 = có; 0 = không)

output: nguy cơ đau tim

Chọn biến nguy cơ bị đau tim làm biếng định tính vì biến output phân tích được các yếu tố như đau thắt ngực do gắng sức đường huyết lúc đói

2.2 Chọn và giải thích biến định lượng

trtbps: Huyết áp khi nghỉ ngơi (tính bằng mm Hg)

giải thích Huyết áp khi nghỉ ngơi phụ thuộc vào nguy cơ đau tim nhịp tim tối đa đạt được

3.Bài tập về nhà số 3

library(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, union

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.3.1

library(scales)

## Warning: package 'scales' was built under R version 4.3.1

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.3.1

## Warning: package 'tidyr' was built under R version 4.3.1

## Warning: package 'readr' was built under R version 4.3.1

## Warning: package 'purrr' was built under R version 4.3.1

## Warning: package 'forcats' was built under R version 4.3.1

## Warning: package 'lubridate' was built under R version 4.3.1

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ lubridate 1.9.2     ✔ tibble    3.2.1
## ✔ purrr     1.0.1     ✔ tidyr     1.3.0
## ✔ readr     2.1.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard()    masks scales::discard()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidyselect)

## Warning: package 'tidyselect' was built under R version 4.3.1

library(epitools)
library(DescTools)

## Warning: package 'DescTools' was built under R version 4.3.1

library(caTools)

## Warning: package 'caTools' was built under R version 4.3.1

library(tidytext)

## Warning: package 'tidytext' was built under R version 4.3.1

3.1 Thống kê mô tả

3.1.2 Biến output (nguy cơ đau tim)

table(heart$output)

## 
##   0   1 
## 138 165

có 165 người có nguy cơ đau tim và 138 người không có nguy cơ đau tim

table(heart$output)/sum(table(heart$output))

## 
##         0         1 
## 0.4554455 0.5445545

tỷ lệ người bị đau tim chiếm 54.45% tỉ lệ người không đau tim chiếm 45.5%

Đồ thị

library(ggplot2)
heart |> ggplot(aes(x = output, y = after_stat(count))) +
geom_bar(fill = 'skyblue') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'nguy cơ đau tim', y = 'số tuổi')

Từ đồ thị ta thấy tỉ lệ người đau tim chiếm 54.5% và không đau tim chiếm 45.5%

3.1.3 Biến sex

table(heart$sex)

## 
##   0   1 
##  96 207

có 207 nam tham gia bình chọn và 96 nữ tham gia bình chọn

table(heart$sex)/sum(table(heart$sex))

## 
##         0         1 
## 0.3168317 0.6831683

nam chiếm 68.31% nữ chiếm 31.6%

đồ thị

library(ggplot2)
heart |> ggplot(aes(x = sex, 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) +labs(x = 'số tuổi', y = 'nguy cơ đau tim')

từ đồ thị ta thấy nam chiếm 68% nữ chiếm 32%

3.1.4 Biến fps: (đường huyết lúc đói > 120 mg/dl) (1 = đúng; 0 = sai)

table(heart$fbs)

## 
##   0   1 
## 258  45

có 45 người đúng lúc đường huyết đói và 258 người sai lúc đường huyết đói

table(heart$fbs)/sum(table(heart$fbs))

## 
##         0         1 
## 0.8514851 0.1485149

tỉ lệ người đúng chiếm 14.8% và sai chiếm 85.14%

đồ thị

library(ggplot2)
heart |> ggplot(aes(x = fbs, 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) +labs(x = 'đường huyết', y = 'nguy cơ đau tim')

Từ đồ thị ta thấy số người bình chọn dúng chiếm 85% và sai chiếm 15%

3.1.5 rest_ecg: kết quả điện tâm đồ khi nghỉ ngơi

table(heart$restecg)

## 
##   0   1   2 
## 147 152   4

table(heart$restecg)/sum(table(heart$restecg))

## 
##          0          1          2 
## 0.48514851 0.50165017 0.01320132

đồ thị

library(ggplot2)
heart |> ggplot(aes(x = restecg, 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) +labs(x = 'điện tâm đồ khi nghỉ ngơi', y = 'nguy cơ đau tim')

3.1.6 Biến exng: đau thắt ngực do gắng sức (1 = có; 0 = không)

table(heart$exng)

## 
##   0   1 
## 204  99

có 99 người đau thắt ngực do gắng sức và 204 người không bị

table(heart$exng)/sum(table(heart$exng))

## 
##         0         1 
## 0.6732673 0.3267327

tỉ lệ người đau ngực do gắng sức chiếm 32.6% và không bị chiếm 67.3%

library(ggplot2)
heart |> ggplot(aes(x = exng, 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) +labs(x = 'đau thắt ngực do gắng sức', y = 'nguy cơ đau tim')

Từ đồ thị ta thấy không đau ngực chiếm 67% và đau ngực chiếm 33%

3.1.7 Biến trtbps: huyết áp khi nghỉ ngơi (tính bằng mm Hg)

table(heart$trtbps)

## 
##  94 100 101 102 104 105 106 108 110 112 114 115 117 118 120 122 123 124 125 126 
##   2   4   1   2   1   3   1   6  19   9   1   3   1   7  37   4   1   6  11   3 
## 128 129 130 132 134 135 136 138 140 142 144 145 146 148 150 152 154 155 156 160 
##  12   1  36   8   5   6   3  13  32   3   2   5   2   2  17   5   1   1   1  11 
## 164 165 170 172 174 178 180 192 200 
##   1   1   4   1   1   2   3   1   1

table(heart$trtbps)/sum(table(heart$trtbps))

## 
##         94        100        101        102        104        105        106 
## 0.00660066 0.01320132 0.00330033 0.00660066 0.00330033 0.00990099 0.00330033 
##        108        110        112        114        115        117        118 
## 0.01980198 0.06270627 0.02970297 0.00330033 0.00990099 0.00330033 0.02310231 
##        120        122        123        124        125        126        128 
## 0.12211221 0.01320132 0.00330033 0.01980198 0.03630363 0.00990099 0.03960396 
##        129        130        132        134        135        136        138 
## 0.00330033 0.11881188 0.02640264 0.01650165 0.01980198 0.00990099 0.04290429 
##        140        142        144        145        146        148        150 
## 0.10561056 0.00990099 0.00660066 0.01650165 0.00660066 0.00660066 0.05610561 
##        152        154        155        156        160        164        165 
## 0.01650165 0.00330033 0.00330033 0.00330033 0.03630363 0.00330033 0.00330033 
##        170        172        174        178        180        192        200 
## 0.01320132 0.00330033 0.00330033 0.00660066 0.00990099 0.00330033 0.00330033

library(ggplot2)
heart |> ggplot(aes(x = trtbps, 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) +labs(x = 'huyết áp khi nghỉ ngơi', y = 'nguy cơ đau tim')

3.1.8 Biến thalach : nhịp tim tối đa đạt được

table(heart$thalachh)

## 
##  71  88  90  95  96  97  99 103 105 106 108 109 111 112 113 114 115 116 117 118 
##   1   1   1   1   2   1   1   2   3   1   2   2   3   2   1   3   3   2   1   1 
## 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 136 137 138 139 140 
##   3   1   4   2   1   7   4   1   1   1   4   4   7   2   1   2   1   3   2   6 
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 
##   3   6   7   7   4   4   5   3   2   7   4   8   3   5   4   6   5   6   4   9 
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 177 178 179 180 181 
##   5  11   9   2   5   3   1   5   6   5   4   7   8   5   3   1   5   5   2   2 
## 182 184 185 186 187 188 190 192 194 195 202 
##   5   1   1   2   1   1   1   1   1   1   1

table(heart$thalachh)/sum(table(heart$thalachh))

## 
##         71         88         90         95         96         97         99 
## 0.00330033 0.00330033 0.00330033 0.00330033 0.00660066 0.00330033 0.00330033 
##        103        105        106        108        109        111        112 
## 0.00660066 0.00990099 0.00330033 0.00660066 0.00660066 0.00990099 0.00660066 
##        113        114        115        116        117        118        120 
## 0.00330033 0.00990099 0.00990099 0.00660066 0.00330033 0.00330033 0.00990099 
##        121        122        123        124        125        126        127 
## 0.00330033 0.01320132 0.00660066 0.00330033 0.02310231 0.01320132 0.00330033 
##        128        129        130        131        132        133        134 
## 0.00330033 0.00330033 0.01320132 0.01320132 0.02310231 0.00660066 0.00330033 
##        136        137        138        139        140        141        142 
## 0.00660066 0.00330033 0.00990099 0.00660066 0.01980198 0.00990099 0.01980198 
##        143        144        145        146        147        148        149 
## 0.02310231 0.02310231 0.01320132 0.01320132 0.01650165 0.00990099 0.00660066 
##        150        151        152        153        154        155        156 
## 0.02310231 0.01320132 0.02640264 0.00990099 0.01650165 0.01320132 0.01980198 
##        157        158        159        160        161        162        163 
## 0.01650165 0.01980198 0.01320132 0.02970297 0.01650165 0.03630363 0.02970297 
##        164        165        166        167        168        169        170 
## 0.00660066 0.01650165 0.00990099 0.00330033 0.01650165 0.01980198 0.01650165 
##        171        172        173        174        175        177        178 
## 0.01320132 0.02310231 0.02640264 0.01650165 0.00990099 0.00330033 0.01650165 
##        179        180        181        182        184        185        186 
## 0.01650165 0.00660066 0.00660066 0.01650165 0.00330033 0.00330033 0.00660066 
##        187        188        190        192        194        195        202 
## 0.00330033 0.00330033 0.00330033 0.00330033 0.00330033 0.00330033 0.00330033

library(ggplot2)
heart |> ggplot(aes(x = thalachh, 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) +labs(x = 'nhịp tim tối đa đạt được', y = 'nguy cơ đau tim')

4. Bài tập về nhà số 4

4.1 Kiểm định tính độc lập cho 2 biến định tính

4.1.1 BIến output và biến fps

output = heart$output
fps = heart$fbs

dt1 <- table(output, heart$fbs)
dt1

##       
## output   0   1
##      0 116  22
##      1 142  23

chisq.test(dt1)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt1
## X-squared = 0.10627, df = 1, p-value = 0.7444

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nguy cơ đau tim của người đó và (đường huyết lúc đói có quan hệ với nhau

4.1.2 BIến output và biến restecg

dt2 <- table(output, heart$restecg)
dt2

##       
## output  0  1  2
##      0 79 56  3
##      1 68 96  1

chisq.test(dt2)

## Warning in chisq.test(dt2): Chi-squared approximation may be incorrect

## 
##  Pearson's Chi-squared test
## 
## data:  dt2
## X-squared = 10.023, df = 2, p-value = 0.006661

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nguy cơ đau tim của người đó và kết quả điện tâm đồ khi nghỉ ngơi quan hệ với nhau

4.1.3 Biến output và biến exng

dt3 <- table(output, heart$exng)
dt3

##       
## output   0   1
##      0  62  76
##      1 142  23

chisq.test(dt3)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt3
## X-squared = 55.945, df = 1, p-value = 7.454e-14

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nguy cơ đau tim của người đó và đau thắt ngực do gắng sức quan hệ với nhau

Biến output và biến sex

dt4 <- table(output, heart$sex)
dt4

##       
## output   0   1
##      0  24 114
##      1  72  93

chisq.test(dt4)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt4
## X-squared = 22.717, df = 1, p-value = 1.877e-06

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nguy cơ đau tim của người đó và giới tính quan hệ với nhau

4.2 Rủi ro tương đối (Risk ratio) và rỷ lệ chênh (oddsratio)

4.2.1 BIến output và biến fbs

library(epitools)
d1 <- table(heart$output, heart$fbs)
riskratio(d1)

## $data
##        
##           0  1 Total
##   0     116 22   138
##   1     142 23   165
##   Total 258 45   303
## 
## $measure
##    risk ratio with 95% C.I.
##      estimate     lower    upper
##   0 1.0000000        NA       NA
##   1 0.8743802 0.5100569 1.498932
## 
## $p.value
##    two-sided
##     midp.exact fisher.exact chi.square
##   0         NA           NA         NA
##   1  0.6284662    0.6308003  0.6254155
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d1, method = "oddsratio")

## $tab
##    
##       0        p0  1        p1 oddsratio    lower    upper   p.value
##   0 116 0.4496124 22 0.4888889 1.0000000       NA       NA        NA
##   1 142 0.5503876 23 0.5111111 0.8540333 0.453091 1.609771 0.6308003
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.2.2 Biến output và restecg

library(epitools)
d2 <- table(heart$output, heart$restecg)
riskratio(d2)

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

## $data
##        
##           0   1 2 Total
##   0      79  56 3   138
##   1      68  96 1   165
##   Total 147 152 4   303
## 
## $measure
##    risk ratio with 95% C.I.
##     estimate    lower    upper
##   0  1.00000       NA       NA
##   1  1.41115 1.112062 1.790677
## 
## $p.value
##    two-sided
##      midp.exact fisher.exact  chi.square
##   0          NA           NA          NA
##   1 0.003478075   0.00362918 0.006660599
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d2, method = "oddsratio")

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

## $tab
##    
##      0       p0  1        p1 oddsratio    lower    upper    p.value
##   0 79 0.537415 56 0.3684211  1.000000       NA       NA         NA
##   1 68 0.462585 96 0.6315789  1.991597 1.254361 3.162133 0.00362918
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.2.3 Biến output và exng

library(epitools)
d3 <- table(heart$output, heart$exng)
riskratio(d3)

## $data
##        
##           0  1 Total
##   0      62 76   138
##   1     142 23   165
##   Total 204 99   303
## 
## $measure
##    risk ratio with 95% C.I.
##     estimate     lower     upper
##   0  1.00000        NA        NA
##   1  0.25311 0.1683163 0.3806209
## 
## $p.value
##    two-sided
##       midp.exact fisher.exact   chi.square
##   0           NA           NA           NA
##   1 1.731948e-14 1.759914e-14 2.902737e-14
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d3, method = "oddsratio")

## $tab
##    
##       0        p0  1        p1 oddsratio      lower     upper      p.value
##   0  62 0.3039216 76 0.7676768 1.0000000         NA        NA           NA
##   1 142 0.6960784 23 0.2323232 0.1321349 0.07595412 0.2298708 1.759914e-14
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.2.4 Biến output và sex

library(epitools)
d4 <- table(heart$output, heart$sex)
riskratio(d4)

## $data
##        
##          0   1 Total
##   0     24 114   138
##   1     72  93   165
##   Total 96 207   303
## 
## $measure
##    risk ratio with 95% C.I.
##      estimate     lower     upper
##   0 1.0000000        NA        NA
##   1 0.6822967 0.5845939 0.7963283
## 
## $p.value
##    two-sided
##       midp.exact fisher.exact   chi.square
##   0           NA           NA           NA
##   1 7.783485e-07 1.042238e-06 1.007164e-06
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d4, method = "oddsratio")

## $tab
##    
##      0   p0   1        p1 oddsratio     lower     upper      p.value
##   0 24 0.25 114 0.5507246 1.0000000        NA        NA           NA
##   1 72 0.75  93 0.4492754 0.2719298 0.1589356 0.4652566 1.042238e-06
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

5. Bài tập về nhà số 5

5.1 Mô hình hồi quy nhị phân biến phụ thuộc output

5.1.2 Mô hình logit

fbs = heart$fbs
restecg = heart$restecg
exng = heart$exng
trtbps = heart$trtbps
sex = heart$sex
thall = heart$thall
mh1 <- glm(data = heart, formula = factor(output) ~ fbs + restecg + exng + trtbps + sex + thall, family = binomial(link = "logit"))
levels(factor(output))

## [1] "0" "1"

summary(mh1)

## 
## Call:
## glm(formula = factor(output) ~ fbs + restecg + exng + trtbps + 
##     sex + thall, family = binomial(link = "logit"), data = heart)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  5.970625   1.292997   4.618 3.88e-06 ***
## fbs          0.045685   0.393597   0.116 0.907597    
## restecg      0.464595   0.267757   1.735 0.082717 .  
## exng        -1.886001   0.307794  -6.127 8.93e-10 ***
## trtbps      -0.018155   0.008331  -2.179 0.029310 *  
## sex         -1.144616   0.325616  -3.515 0.000439 ***
## thall       -0.962318   0.232137  -4.145 3.39e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 417.64  on 302  degrees of freedom
## Residual deviance: 311.40  on 296  degrees of freedom
## AIC: 325.4
## 
## Number of Fisher Scoring iterations: 4

5.1.3 Mô hình probit

mh2 <- glm(data = heart, formula = factor(output) ~ fbs + restecg + exng + trtbps + sex + thall, family = binomial(link = "probit"))
levels(factor(output))

## [1] "0" "1"

summary(mh2)

## 
## Call:
## glm(formula = factor(output) ~ fbs + restecg + exng + trtbps + 
##     sex + thall, family = binomial(link = "probit"), data = heart)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.51341    0.74038   4.745 2.08e-06 ***
## fbs         -0.01295    0.23182  -0.056  0.95544    
## restecg      0.27103    0.15720   1.724  0.08468 .  
## exng        -1.13040    0.17791  -6.354 2.10e-10 ***
## trtbps      -0.01056    0.00486  -2.174  0.02971 *  
## sex         -0.69705    0.18676  -3.732  0.00019 ***
## thall       -0.55705    0.13667  -4.076 4.58e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 417.64  on 302  degrees of freedom
## Residual deviance: 311.18  on 296  degrees of freedom
## AIC: 325.18
## 
## Number of Fisher Scoring iterations: 5

5.1.4 Mô hình cloglog

mh3 <- glm(data = heart, formula = factor(output) ~ fbs + restecg + exng + trtbps + sex + thall, family = binomial(link = "cloglog"))
levels(factor(output))

## [1] "0" "1"

summary(mh3)

## 
## Call:
## glm(formula = factor(output) ~ fbs + restecg + exng + trtbps + 
##     sex + thall, family = binomial(link = "cloglog"), data = heart)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.196219   0.818519   3.905 9.43e-05 ***
## fbs         -0.059309   0.252777  -0.235 0.814495    
## restecg      0.261346   0.168170   1.554 0.120172    
## exng        -1.360611   0.231510  -5.877 4.17e-09 ***
## trtbps      -0.010439   0.005469  -1.909 0.056278 .  
## sex         -0.781553   0.183090  -4.269 1.97e-05 ***
## thall       -0.562245   0.155025  -3.627 0.000287 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 417.64  on 302  degrees of freedom
## Residual deviance: 311.62  on 296  degrees of freedom
## AIC: 325.62
## 
## Number of Fisher Scoring iterations: 12

5.2 Lựa chọn mô hình

# Tiêu chí AIC - Akaike Information Criterion
aic1 <- AIC(mh1)
aic2 <- AIC(mh2)
aic3 <- AIC(mh3)
AIC <-cbind(aic1,aic2,aic3)
AIC

##          aic1     aic2     aic3
## [1,] 325.4011 325.1838 325.6242

# Tiêu chí Deviance
de1 <- deviance(mh1)
de2 <- deviance(mh2)
de3 <- deviance(mh3)
deviance <- cbind(de1,de2,de3)
deviance

##           de1      de2      de3
## [1,] 311.4011 311.1838 311.6242

# Tiêu chí Brier Score
bs1 <- BrierScore(mh1)
bs2 <- BrierScore(mh2)
bs3 <- BrierScore(mh3)
BrierScore <- cbind(bs1,bs2,bs3)
BrierScore

##            bs1       bs2       bs3
## [1,] 0.1705346 0.1708001 0.1712665

Dựa vào 3 tiêu chí AIC, Deviance, BrierScore, ta thấy 3 tiêu chí của mô hình logit nhỏ nhất, tức là mô hình logit là mô hình tối nhất trong 3 mô hình.

5.3 Kết quả mô hình logit

summary(mh1)

## 
## Call:
## glm(formula = factor(output) ~ fbs + restecg + exng + trtbps + 
##     sex + thall, family = binomial(link = "logit"), data = heart)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  5.970625   1.292997   4.618 3.88e-06 ***
## fbs          0.045685   0.393597   0.116 0.907597    
## restecg      0.464595   0.267757   1.735 0.082717 .  
## exng        -1.886001   0.307794  -6.127 8.93e-10 ***
## trtbps      -0.018155   0.008331  -2.179 0.029310 *  
## sex         -1.144616   0.325616  -3.515 0.000439 ***
## thall       -0.962318   0.232137  -4.145 3.39e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 417.64  on 302  degrees of freedom
## Residual deviance: 311.40  on 296  degrees of freedom
## AIC: 325.4
## 
## Number of Fisher Scoring iterations: 4

\(Logit(\pi) = 2.641541 + 0.055490fbs + 0.453681restecg - 2.012973exng - 0.015635trtbps - 1.144616sex - 0.962318thall\)

Kết quả phân tích hồi quy Logit cho thấy 6 biến đưa vào mô hình hồi quy để phân tích nhưng kết quả phân tích chỉ có 4 biến độc lập có ý nghĩa thống kê bao gồm:

exng đau thắt ngực do gắng sức (1 = có; 0 = không)

trtbps huyết áp khi nghỉ ngơi (tính bằng mm Hg)

sex Giới tính bệnh nhân

thall nhịp tim tối đa đạt được

Với giả thuyết các yếu tố khác không đổi, ảnh hưởng của từng biến đến được diễn giải như sau:

đau thắc ngực do gắng sức khác nhau sẽ có tác động đên nguy cơ đau tim Ở mức ý nghĩa 5%, ước lượng -1.886001 cho biết biến này có mối quan hệ tiêu cực

trtbps huyết áp khi nghỉ ngơi (tính bằng mm Hg) sẽ có tác động đên nguy cơ đau tim Ở mức ý nghĩa 5%, ước lượng -0.018155 cho biết biến này có mối quan hệ tiêu cực

sex Giới tính bệnh nhân sẽ có tác động đên nguy cơ đau tim Ở mức ý nghĩa 5%, ước lượng -1.144616 cho biết biến này có mối quan hệ tiêu cực

thall nhịp tim tối đa đạt được sẽ có tác động đên nguy cơ đau tim Ở mức ý nghĩa 5%, ước lượng -0.962318 cho biết biến này có mối quan hệ tiêu cực

5.4 Độ chính xác mô hình

library(caret)

## Warning: package 'caret' was built under R version 4.3.1

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following objects are masked from 'package:DescTools':
## 
##     MAE, RMSE

## The following object is masked from 'package:purrr':
## 
##     lift

### Mô hình logit
predictions <- predict(mh1, newdata = heart, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "1", "0")
predictions1<-factor(predicted_classes, levels = c("0","1"))
actual<- factor(heart$output, labels = c("0","1"))
confusionMatrix(table(predictions1, actual))

## Confusion Matrix and Statistics
## 
##             actual
## predictions1   0   1
##            0  94  30
##            1  44 135
##                                           
##                Accuracy : 0.7558          
##                  95% CI : (0.7034, 0.8031)
##     No Information Rate : 0.5446          
##     P-Value [Acc > NIR] : 2.312e-14       
##                                           
##                   Kappa : 0.5035          
##                                           
##  Mcnemar's Test P-Value : 0.1307          
##                                           
##             Sensitivity : 0.6812          
##             Specificity : 0.8182          
##          Pos Pred Value : 0.7581          
##          Neg Pred Value : 0.7542          
##              Prevalence : 0.4554          
##          Detection Rate : 0.3102          
##    Detection Prevalence : 0.4092          
##       Balanced Accuracy : 0.7497          
##                                           
##        'Positive' Class : 0               
## 

Mô hình có 75.58% độ chính xác, có độ nhạy 68.12% và độ hiệu quả là 81.82%

Bài tập về nhà nhiệm vụ số 6

file PDF bài về nhà

file:///D:/BTVN%20PTDLDT.pdf