BTVN
NGUYỄN THUÝ NGÂN
2023-06-21
library(readxl)
library(DT)## Warning: package 'DT' was built under R version 4.3.1library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.1library(epitools)
library(DescTools)## Warning: package 'DescTools' was built under R version 4.3.1dataset <- read_excel("D:/MPNN/data/dataset1.xlsx")
age <- cut(dataset$Age, breaks = c(25,50,80), labels=c("trung niên","lớn tuổi"))
trtb <- cut(dataset$Trtbps, breaks = c(50,120,200), labels=c("trung binh","cao"))1 NHIỆM VỤ TUẦN 5
1.1 Mô hình hồi quy cho biến phụ thuộc kết quả (Outcome)
1.1.1 Mô hình logit
mh1 <- glm(data = dataset , formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "logit"))
levels(factor(dataset$Outcome))## [1] "Less chance of heart attack" "More chance of heart attack"summary(mh1)##
## Call:
## glm(formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "logit"),
## data = dataset)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.1554 0.3752 5.744 9.23e-09 ***
## agelớn tuổi -1.0033 0.2813 -3.566 0.000362 ***
## trtbcao -0.3268 0.2739 -1.193 0.232839
## dataset$SexM -1.4790 0.2873 -5.148 2.64e-07 ***
## ---
## 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: 373.95 on 299 degrees of freedom
## AIC: 381.95
##
## Number of Fisher Scoring iterations: 41.1.2 Mô hình probit
mh2 <- glm(data = dataset , formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "probit"))
levels(factor(dataset$Outcome))## [1] "Less chance of heart attack" "More chance of heart attack"summary(mh2)##
## Call:
## glm(formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "probit"),
## data = dataset)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.3447 0.2202 6.106 1.02e-09 ***
## agelớn tuổi -0.6238 0.1705 -3.658 0.000254 ***
## trtbcao -0.2088 0.1670 -1.250 0.211150
## dataset$SexM -0.9216 0.1709 -5.392 6.98e-08 ***
## ---
## 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: 373.34 on 299 degrees of freedom
## AIC: 381.34
##
## Number of Fisher Scoring iterations: 41.1.3 Mô hình cloglog
mh3 <- glm(data = dataset , formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "cloglog"))
levels(factor(dataset$Outcome))## [1] "Less chance of heart attack" "More chance of heart attack"summary(mh3)##
## Call:
## glm(formula = factor(Outcome) ~ age + trtb + dataset$Sex, family = binomial(link = "cloglog"),
## data = dataset)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.0926 0.2124 5.145 2.68e-07 ***
## agelớn tuổi -0.6918 0.1795 -3.855 0.000116 ***
## trtbcao -0.2498 0.1793 -1.394 0.163380
## dataset$SexM -1.0197 0.1737 -5.872 4.30e-09 ***
## ---
## 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: 371.56 on 299 degrees of freedom
## AIC: 379.56
##
## Number of Fisher Scoring iterations: 62 NHIỆM VỤ TUẦN 4
Phân tích thống kê mô tả của 2 biến phụ thuộc ở câu 2 với 5 biến còn lại trong câu 3, nhận xét về kết quả phân tích này.
2.1 Thống kê mô tả cho 2 biến giới tính (Sex) và biến kết quả (Outcome)
2.1.1 Bảng tần số, tần suất và biểu đồ
#Bảng tần số
tkq <- table(dataset$Sex,dataset$Outcome)
tkq##
## Less chance of heart attack More chance of heart attack
## F 23 72
## M 115 93Có 23 giới tính nữ và 115 giới tính nam có kết quả ít nguy cơ đau tim hơn. Có 72 giới tính nữ và 93 giới tính nam có kết quả nhiều nguy cơ đau tim hơn.
#bảng tần suất
prop.table(tkq)##
## Less chance of heart attack More chance of heart attack
## F 0.07590759 0.23762376
## M 0.37953795 0.30693069#phân phối biên
addmargins(tkq)##
## Less chance of heart attack More chance of heart attack Sum
## F 23 72 95
## M 115 93 208
## Sum 138 165 303Biểu đồ kết hợp 2 biến:
ggplot(dataset, aes(Sex, fill = Outcome)) + geom_bar(position = 'dodge')
2.1.2 Rủi ro tương đối
addmargins(tkq)##
## Less chance of heart attack More chance of heart attack Sum
## F 23 72 95
## M 115 93 208
## Sum 138 165 303#Rủi ro tương đối (relative risk)
RelRisk(tkq)## [1] 0.4378947Theo kết quả trên ta thấy tỷ lệ kết quả ít nguy cơ đau tim là nữ bằng 43,78947% tỷ lệ ít nguy cơ đau tim là nam
2.1.3 Tỷ lệ chênh lệch (odd ratio)
epitab(tkq, method = "oddsratio")## $tab
##
## Less chance of heart attack p0 More chance of heart attack p1
## F 23 0.1666667 72 0.4363636
## M 115 0.8333333 93 0.5636364
##
## oddsratio lower upper p.value
## F 1.0000000 NA NA NA
## M 0.2583333 0.1500599 0.4447297 4.912871e-07
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Tỷ lệ kết quả nhiều nguy cơ bị đau tim là nữ bằng 25,83% kết quả nhiều nguy cơ bị đau tim là nam.
2.1.4 Thống kê suy diễn
Đặt giải thuyết:
\(H_{0}\): hai biến độc lập với nhau
\(H_{1}\): hai biến không độc lập
chisq.test(tkq)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tkq
## X-squared = 24.159, df = 1, p-value = 8.871e-07Kết quả cho thấy p-value < 0,05 nên ta chấp nhận \(H_{0}\). Vậy biến giới tính và kết quả độc lập với nhau
2.2 Thống kê mô tả cho 2 biến tuổi (Age) và kết quả (outcome)
2.2.1 Mã hóa biến tuổi (Age)
Ở dữ liệu gốc biến tuổi gồm nhiều độ tuổi khác nhau. Để chuyển về biến định tính tôi quy ước như sau: từ 25-50 tuổi là trung niên; từ 50-80 tuổi là lớn tuổi
age <- cut(dataset$Age, breaks = c(25,50,80), labels=c("trung niên","lớn tuổi"))
table(age)## age
## trung niên lớn tuổi
## 95 2082.2.2 Bảng tần số, tần suất và biểu đồ
#Bảng tần số
tuoi <- table(age,dataset$Outcome)
tuoi##
## age Less chance of heart attack More chance of heart attack
## trung niên 29 66
## lớn tuổi 109 99#bảng tần suất
prop.table(tuoi)##
## age Less chance of heart attack More chance of heart attack
## trung niên 0.09570957 0.21782178
## lớn tuổi 0.35973597 0.32673267#phân phối biên
addmargins(tuoi)##
## age Less chance of heart attack More chance of heart attack Sum
## trung niên 29 66 95
## lớn tuổi 109 99 208
## Sum 138 165 303Biểu đồ kết hợp 2 biến:
library(ggplot2)
ggplot(dataset, aes(age, fill = Outcome)) + geom_bar(position = 'dodge')
2.2.3 Rủi ro tương đối
addmargins(tuoi)##
## age Less chance of heart attack More chance of heart attack Sum
## trung niên 29 66 95
## lớn tuổi 109 99 208
## Sum 138 165 303#Rủi ro tương đối (relative risk)
library(DescTools)
RelRisk(tuoi)## [1] 0.58252052.2.4 Tỷ lệ chênh lệch (odd ratio)
library(epitools)
epitab(tuoi, method = "oddsratio")## $tab
##
## age Less chance of heart attack p0 More chance of heart attack
## trung niên 29 0.2101449 66
## lớn tuổi 109 0.7898551 99
##
## age p1 oddsratio lower upper p.value
## trung niên 0.4 1.0000000 NA NA NA
## lớn tuổi 0.6 0.3990826 0.2385706 0.6675881 0.0004723447
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"2.2.5 Thống kê suy diễn
Đặt giải thuyết:
\(H_{0}\): hai biến độc lập với nhau
\(H_{1}\): hai biến không độc lập
chisq.test(tuoi)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tuoi
## X-squared = 11.719, df = 1, p-value = 0.0006188Kết quả cho thấy p-value < 0,05 nên ta chấp nhận \(H_{0}\). Vậy biến tuổi và kết quả độc lập với nhau
2.3 Thống kê mô tả cho 2 biến chỉ số huyết áp (Trtbps) và kết quả (outcome)
2.3.1 Mã hóa biến chỉ số huyết áp
#Chuyển biến chỉ số huyết áp từ biến định lượng sang biến định tính
trtb <- cut(dataset$Trtbps, breaks = c(50,120,200), labels=c("trung binh","cao"))
table(trtb)## trtb
## trung binh cao
## 97 2062.3.2 Bảng tần số, tần suất và biểu đồ
#Bảng tần số
ap <- table(trtb,dataset$Outcome)
ap##
## trtb Less chance of heart attack More chance of heart attack
## trung binh 37 60
## cao 101 105Có 37 người chỉ số huyết áp trung bình và 101 người chỉ số huyết áp cao có kết quả ít có nguy cơ đau tim hơn
Có 60 người chỉ số huyết áp trung bình và 105 người chỉ số huyết áp cao có kết quả nhiều có nguy cơ đau tim hơn
Biểu đồ kết hợp 2 biến:
library(ggplot2)
ggplot(dataset, aes(trtb, fill = Outcome)) + geom_bar(position = 'dodge')
3 NHIỆM VỤ TUẦN 3
Làm thống kê mô tả cho ít nhất 7 biến (vừa định tính định lượng và có 2 biến đã chọn ở câu 2) nhận xét về kết quả phân tích này.
3.1 Thống kê mô tả các biến
3.1.1 Thống kê biến tuổi (AGE)
summary(dataset$Age)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 29.00 47.50 55.00 54.37 61.00 77.00library(ggplot2)
hist(dataset$Age, main = "Biểu đồ tần số của độ tuổi (age)",xlab = "Độ tuổi", ylab = "Số bệnh nhân", col = "#E6E6FA")
Số bệnh nhân trong khảo sát tập trung trong độ tuổi từ 50-60 tuổi. Đây là độ tuổi gặp khá nhiều vấn đề về sức khỏe.
3.1.2 Thống kê biến giới tính (sex)
table(dataset$Sex)##
## F M
## 95 208table(dataset$Sex)/sum(table(dataset$Sex))##
## F M
## 0.3135314 0.6864686library(ggplot2)
ggplot(dataset,aes(Sex)) + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = '#CD6889', vjust = - .5) + geom_bar(color ="#BCD2EE", fill = "#EEA9B8") + ylab("Số bệnh nhân") +
xlab("Giới tính (sex)")
Qua đồ thị có thể thấy, tỷ lệ bệnh nhân nữ chiếm 31%, bệnh nhân nam chiếm 69%.
3.1.3 Thống kê mô tả biến các loại đau thắt ngực (cp)
# Bảng tuần suất biến cp
table(dataset$Cp)##
## Asymptomatic Atypical Angina Non-anginal Pain Typical Angina
## 23 50 87 143table(dataset$Cp)/sum(table(dataset$Cp))##
## Asymptomatic Atypical Angina Non-anginal Pain Typical Angina
## 0.07590759 0.16501650 0.28712871 0.47194719library(ggplot2)
ggplot(dataset,aes(Cp)) + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = '#CD6889', vjust = - .5) + geom_bar(color ="#BCD2EE", fill = "#6495ED") + ylab("Số bệnh nhân") + xlab("Các loại đau thắt ngực")
Qua đồ thị có thể thấy là có khoảng 7,6% bệnh nhân không có triệu chứng; 16,5% bệnh nhân đau thắt ngực không điển hình; 28,7% bệnh nhân không đau thắt ngực; 47,2% bệnh nhân đau thắt ngực điển hình.
Có thể thấy số bệnh nhân bị đau thắt ngực điển hình chiếm gần như phân nữa số bệnh nhân.
3.1.4 Thống kê mô tả biến chỉ số huyết áp khi nghỉ ngơi (Trtbps)
summary(dataset$Trtbps)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 94.0 120.0 130.0 131.6 140.0 200.0library(ggplot2)
hist(dataset$Trtbps, main = "Biểu đồ chỉ số huyết áp khi nghỉ ngơi",xlab = "Chỉ số huyết áp", ylab = "Số người", col = "#CD853F")
Qua biểu đồ có thể thấy chỉ số huyết áp khi nghỉ ngơi phân bố nhiều nhất từu 120-140
3.1.5 Thống kê mô tả biến cholestoral
summary(dataset$Chol)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 126.0 211.0 240.0 246.3 274.5 564.0library(ggplot2)
hist(dataset$Chol, main = "Biểu đồ chỉ số cholestoral",xlab = "Chỉ số cholestoral", ylab = "Số người", col = "#FF8C69")
Qua biểu đồ cho thấy chỉ số Chol nhiều nhất từ 200-300
3.1.6 Thống kê mô tả biến đường huyết
table(dataset$Fbs)##
## 0 1
## 258 45table(dataset$Fbs)/sum(table(dataset$Fbs))##
## 0 1
## 0.8514851 0.1485149library(ggplot2)
ggplot(dataset,aes(Fbs)) + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = '#CD6889', vjust = - .5) + geom_bar(color ="#BCD2EE", fill = "#6495ED") + ylab("số bệnh nhân") + xlab("Đường huyết (fbs)") 
3.1.7 Thống kê mô tả biến kết quả tâm đồ lúc nghỉ ngơi (rest_ecg)
table(dataset$Restecg)##
## Left ventricular hypertrophy Normal
## 4 147
## ST-T wave normality
## 152table(dataset$Restecg)/sum(table(dataset$Restecg))##
## Left ventricular hypertrophy Normal
## 0.01320132 0.48514851
## ST-T wave normality
## 0.50165017library(ggplot2)
ggplot(dataset,aes(Restecg)) + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = '#CD6889', vjust = - .5) + geom_bar(color ="#48D1CC", fill = "#EEE8AA") + ylab("số bệnh nhân") + xlab("kết quả tâm đồ lúc nghỉ ngơi")
3.1.8 Thống kê mô tả biến Kết quả (Outcome)
table(dataset$Outcome)##
## Less chance of heart attack More chance of heart attack
## 138 165table(dataset$Outcome)/sum(table(dataset$Outcome))##
## Less chance of heart attack More chance of heart attack
## 0.4554455 0.5445545library(ggplot2)
k <- ggplot(dataset,aes(Outcome)) + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = '#CD6889', vjust = - .5) + geom_bar(color ="white", fill = "#EEE8AA") + ylab("số bệnh nhân") + xlab("Kết quả")
k
Qua đồ thị ta thấy được có khoảng 45,5% số bệnh nhân ít có khả năng đau tim hơn và 54,5% số bệnh nhân có nhiều khả năng bị đau tim
4 NHIỆM VỤ TUẦN 2
Chọn 1 hoặc 2 biến định tính và 1 biến định lượng làm biến phụ thuộc để phân tích, giải thích lý do.
4.1 Biến định tính
Tôi chọn biến định tính “Outcome” làm biến phụ thuộc. Đây là những biến mô tả được kết quả thông tin khảo sát và không thể đo lường hay đếm được, được xác định dựa trên các thông tin được khảo sát. Đây cũng là biến chịu nhiều tác động bởi nhiều biến khác như tuổi, huyết áp, nhịp tim, đường huyết.
4.2 Biến định lượng
Tôi chọn biến định lượng cholestoral là biến phụ thuộc. Đây là biến được đếm và đo lường dựa trên khảo sát của nhiều người, dựa vào đó ta có thể tính toán được tác động của nó lên kết quả khảo sát. Đây là biến phụ thuộc vì nó cũng được tác động bởi biến đường huyết, huyết áp.
5 NHIỆM VỤ TUẦN 1
Tìm một dataset có dữ liệu định tính, dữ liệu định lượng, có trên 5 biến và nhiều hơn 300 quan sát.
5.1 Giới thiệu
Cơn đau tim thường xảy ra khi dòng máu dẫn đến tim bị tắc nghẽn, thường là do sự tích tụ của chất béo, cholesterol và nhiều chất khác, lâu ngày tạo thành mảng bám trong động mạch. Cho tới khi mảng bám đó có thể vỡ ra và hình thành cục máu đông ngăn chặn dòng máu. Dẫn đến dòng máu bị ngăn lại xảy ra cơn đau thắt tim.
Dữ liệu được lấy từ website https://www.kaggle.com/, bao gồm 11 biến và 303 quan sát. Dữ liệu được thu thập cho người xem thấy được một người bệnh có nhiều khả năng bị tim hơn hay ít hơn.
5.2 Dữ liệu
Trong đó:
ID: Mã của người bệnh
Age : Age of the patient : tuổi
Sex : Sex of the patient : giới tính
cp : Chest Pain type: Các loại đau thắt ngực
Value 1: typical angina : đau thắt ngực điển hình
Value 2: atypical angina : đau thắt ngực không điển hình
Value 3: non-anginal pain : không đau thắt ngực
Value 4: asymptomatic : không có triệu chứng
trtbps : resting blood pressure (in mm Hg) : Chỉ số huyết áp khi nghỉ ngơi
chol : cholestoral in mg/dl fetched via BMI sensor: Cholestoral
fbs : (fasting blood sugar >= 120 mg/dl) (1 = true; 0 = false) : Đường huyết
rest_ecg : resting electrocardiographic results : Kết quả tâm đồ lúc nghỉ ngơi
normal : Bình thường
having ST-T wave abnormality (T wave inversions and/or ST elevation or depression of > 0.05 mV) : có sóng ST-T bất thường
showing probable or definite left ventricular hypertrophy by Estes’ criteria : Phì đại tâm thất trái
thalach : maximum heart rate achieved : Nhịp tim tối đa nhận được
exng: exercise induced angina (1 = yes; 0 = no) : Đau thắt ngực khi cố gắng hết sức ( 1 = có; 0= không có)
outcome : 0= less chance of heart attack 1= more chance of heart attack : Mục tiêu ( 0 = ít khả năng bị đau tim hơn; 1 = nhiều khả năng bị đau tim hơn )
library(readxl)
library(DT)
dataset <- read_excel("D:/MPNN/data/dataset1.xlsx")
datatable(dataset)summary(dataset)## ID Age Sex Cp
## Min. : 1.0 Min. :29.00 Length:303 Length:303
## 1st Qu.: 76.5 1st Qu.:47.50 Class :character Class :character
## Median :152.0 Median :55.00 Mode :character Mode :character
## Mean :152.0 Mean :54.37
## 3rd Qu.:227.5 3rd Qu.:61.00
## Max. :303.0 Max. :77.00
## Trtbps Chol Fbs Restecg
## Min. : 94.0 Min. :126.0 Min. :0.0000 Length:303
## 1st Qu.:120.0 1st Qu.:211.0 1st Qu.:0.0000 Class :character
## Median :130.0 Median :240.0 Median :0.0000 Mode :character
## Mean :131.6 Mean :246.3 Mean :0.1485
## 3rd Qu.:140.0 3rd Qu.:274.5 3rd Qu.:0.0000
## Max. :200.0 Max. :564.0 Max. :1.0000
## Thalachh Exang Outcome
## Min. : 71.0 Min. :0.0000 Length:303
## 1st Qu.:133.5 1st Qu.:0.0000 Class :character
## Median :153.0 Median :0.0000 Mode :character
## Mean :149.6 Mean :0.3267
## 3rd Qu.:166.0 3rd Qu.:1.0000
## Max. :202.0 Max. :1.0000Nhìn vào đồ thị có thể thấy tỷ lệ chênh lệch giữa “ít khả năng bị đau tim hơn” và “nhiều khả năng bị đau tim hơn”. Có thể thấy rằng người bệnh có nhiều khae năng dẫn đến cơn đau tim là nhiều hơn.