Prediksi Pasien Penyakit Jantung
Pada kali ini, saya akan mencoba untuk melakukan prediksi terhadap pasien penyakit jantung pada suatu rumah sakit yang akan diprediksi sakit atau tidak. Algoritma yang digunakan yaitu logistic regission dan K-Nearest Neighboor yang merupakan supervised learning.
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(class)
library(tidyr)
library(caret)## Loading required package: lattice## Loading required package: ggplot2Dataset yang saya gunakan yaitu data mengenai pasien yang terkena penyakit jantung berdasarkan beberapa karakteristik yang menyertai yang dapat diunduh pada link berikut https://www.kaggle.com/ronitf/heart-disease-uci .
jantung <- read.csv("dataset/heart.csv")glimpse(jantung)## Rows: 303
## Columns: 14
## $ ï..age <int> 63, 37, 41, 56, 57, 57, 56, 44, 52, 57, 54, 48, 49, 64, 58...
## $ sex <int> 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0...
## $ cp <int> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3...
## $ trestbps <int> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130...
## $ chol <int> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275...
## $ fbs <int> 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0...
## $ restecg <int> 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1...
## $ thalach <int> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139...
## $ exang <int> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0...
## $ oldpeak <dbl> 2.3, 3.5, 1.4, 0.8, 0.6, 0.4, 1.3, 0.0, 0.5, 1.6, 1.2, 0.2...
## $ slope <int> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2...
## $ ca <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2...
## $ thal <int> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2...
## $ target <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1...Informasi penting yang terdapat didata:
i..age : umur data tahun sex : jenis kelamin (1 = laki-laki, 0 = perempuan) cp : tipe nyeri yang paling parah trestbps : melacak tekanan darah (dalam mm Hg saat masuk kerumah sakit) chol : Kolesterol dalam mg / dl fbs : gula darah dalam keadaan puasa >120 mg / dl (1 = benar, 0 = salah) restecg : mengembalikan hasil elektokardiografi thalach : denyut jantung maksimum tercapai exang : exercise included angina (1 = ya, 0 = tidak) oldpeak : ST depresi yang disebabkan oleh olahraga slope : Kemiringan segmen ST latihan puncak ca : Jumlah pembuluh darah utama (0-3) diwarnai dengan fluoroskopi thal : (3 = normal, 6 = cacat tetap, 7 = cacat yang dapat dibalik) target : (1 = sakit, 0 = tidak)
head(jantung)Pada beberapa variabel yang digunakan, terdapat ketidaksesuaian tipe data dan tipe data yang tidak digunakan maka harus disesuaikan.
jantung <- jantung %>%
select(-ï..age) %>%
mutate_if(is.integer, as.factor) %>%
mutate(sex = factor(sex, levels = c(0,1), labels = c("Female", "Male")),
fbs =factor(fbs, levels = c(0,1), labels = c("False", "True")),
exang = factor(exang, levels = c(0,1), labels = c("Tidak", "Iya")),
target = factor(target, levels = c(0,1),
labels = c("Sehat", "Tidak Sehat")))glimpse(jantung)## Rows: 303
## Columns: 13
## $ sex <fct> Male, Male, Female, Male, Female, Male, Female, Male, Male...
## $ cp <fct> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3...
## $ trestbps <fct> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130...
## $ chol <fct> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275...
## $ fbs <fct> True, False, False, False, False, False, False, False, Tru...
## $ restecg <fct> 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1...
## $ thalach <fct> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139...
## $ exang <fct> Tidak, Tidak, Tidak, Tidak, Iya, Tidak, Tidak, Tidak, Tida...
## $ oldpeak <dbl> 2.3, 3.5, 1.4, 0.8, 0.6, 0.4, 1.3, 0.0, 0.5, 1.6, 1.2, 0.2...
## $ slope <fct> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2...
## $ ca <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2...
## $ thal <fct> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2...
## $ target <fct> Tidak Sehat, Tidak Sehat, Tidak Sehat, Tidak Sehat, Tidak ...colSums(is.na(jantung))## sex cp trestbps chol fbs restecg thalach exang
## 0 0 0 0 0 0 0 0
## oldpeak slope ca thal target
## 0 0 0 0 0prop.table(table(jantung$target))##
## Sehat Tidak Sehat
## 0.4554455 0.5445545Jika kita lihat dari proposi kedua kelas tersebut sudah cukup seimbang dan tidak membutuhkan pre-processing tambahan untuk perlu menyeimbangi proporsi antar kedua kelas target variabel.
Selanjutnya adalah melakukan splitting data menjadi data train dan data test. Splitting data train dan test ini bertujuan untuk membuat model yang digunakan yaitu data test dan data test tujuannya untuk menguji model terhadap unseen data. Splitting data train dan test ini saya menggunakan proporsi 80% untuk data train dan 20% untuk data test
RNGkind(sample.kind = "Rounding") # tambahan khusus u/ R 3.6 ke atas ## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## usedset.seed(406)
intrain <- sample(nrow(jantung), nrow(jantung)*0.8)
jantung.train <- jantung[intrain,]
jantung.test <- jantung[-intrain,]prop.table(table(jantung.train$target))##
## Sehat Tidak Sehat
## 0.4421488 0.5578512Dari hasil re-check tersebut hasil yang saya peroleh bahwa data train nya masih seimbang dan tidak perlu pre-processing tambahan lagi untuk data train.
Membuat model dengan menggunakan regresi logistik. Pemodelan menggunakan fungsi glm() dalam membuat model regresi logistik. Variabel yang digunakan adalah variabel yang dianggap mempengaruhi target variabel.
model_jantung <- glm(formula = target~sex+cp+fbs+exang+oldpeak+slope+ca+thal, family = "binomial",
data = jantung.train)summary(model_jantung)##
## Call:
## glm(formula = target ~ sex + cp + fbs + exang + oldpeak + slope +
## ca + thal, family = "binomial", data = jantung.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.2145 -0.2631 0.0989 0.4064 2.2551
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2217 4.5904 -0.266 0.790138
## sexMale -1.3481 0.6009 -2.244 0.024860 *
## cp1 1.3301 0.6258 2.125 0.033562 *
## cp2 2.8983 0.6698 4.327 1.51e-05 ***
## cp3 2.4023 0.7726 3.109 0.001876 **
## fbsTrue 0.6027 0.7244 0.832 0.405420
## exangIya -0.8391 0.5059 -1.658 0.097219 .
## oldpeak -0.5814 0.2821 -2.061 0.039307 *
## slope1 -0.2145 1.0679 -0.201 0.840779
## slope2 1.9254 1.1406 1.688 0.091415 .
## ca1 -2.9971 0.6229 -4.812 1.50e-06 ***
## ca2 -3.5460 0.9591 -3.697 0.000218 ***
## ca3 -2.3189 1.1674 -1.986 0.046991 *
## ca4 -1.6238 4.3064 -0.377 0.706115
## thal1 3.2105 4.5067 0.712 0.476230
## thal2 2.9068 4.4422 0.654 0.512886
## thal3 1.1658 4.4363 0.263 0.792716
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 332.24 on 241 degrees of freedom
## Residual deviance: 138.64 on 225 degrees of freedom
## AIC: 172.64
##
## Number of Fisher Scoring iterations: 6backward_jantung <- step(object = model_jantung, direction = "backward", trace = F)
summary(backward_jantung)##
## Call:
## glm(formula = target ~ sex + cp + exang + oldpeak + slope + ca +
## thal, family = "binomial", data = jantung.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.2314 -0.2298 0.1041 0.4155 2.2533
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.8317 5.2370 -0.159 0.873820
## sexMale -1.3372 0.6031 -2.217 0.026601 *
## cp1 1.3210 0.6164 2.143 0.032119 *
## cp2 2.9753 0.6653 4.472 7.75e-06 ***
## cp3 2.5017 0.7755 3.226 0.001256 **
## exangIya -0.8326 0.5036 -1.653 0.098284 .
## oldpeak -0.5944 0.2837 -2.095 0.036188 *
## slope1 -0.3144 1.0508 -0.299 0.764797
## slope2 1.7667 1.1134 1.587 0.112588
## ca1 -2.8835 0.5968 -4.832 1.35e-06 ***
## ca2 -3.5289 0.9719 -3.631 0.000282 ***
## ca3 -2.2234 1.1667 -1.906 0.056687 .
## ca4 -1.3725 4.9584 -0.277 0.781923
## thal1 3.0237 5.1840 0.583 0.559711
## thal2 2.6426 5.1210 0.516 0.605840
## thal3 0.9049 5.1175 0.177 0.859654
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 332.24 on 241 degrees of freedom
## Residual deviance: 139.34 on 226 degrees of freedom
## AIC: 171.34
##
## Number of Fisher Scoring iterations: 6Dengan menggunakan backward_jantung hasil dari stepwise backward akan dihitung prediksi probability sakit atau tidak untuk jantung.test.
jantung.test$pred.Risk <- predict(backward_jantung, newdata = jantung.test, type = "response")head(jantung.test)Sekarang dengan mengklasifikasikan jantung.test berdasarkan pred.Risk dengan syarat lebih besar dari 0.5.
jantung.test$pred.Label <- ifelse(jantung.test$pred.Risk > 0.5, "Tidak Sehat","Sehat")
jantung.test$pred.Label <- as.factor(jantung.test$pred.Label)# jantung.test$pred.Label <- ifelse(jantung.test$pred.Risk > 0.5, yes = "Tidak Sehat", no = "Sakit")
#
# jantung.test$pred.Label <- as.factor(jantung.test$pred.Label)Sekarang kita melihat hasil prediksi berdasarkan klasifikasi yang telah dibuat diatas.
jantung.test %>%
select(target, pred.Label) %>%
head(10)Dalam mengevaluasi model yang telah dibuat dengan menggunakan confusion matrix.
confusionMatrix(jantung.test$pred.Label, jantung.test$target, positive = "Tidak Sehat")## Confusion Matrix and Statistics
##
## Reference
## Prediction Sehat Tidak Sehat
## Sehat 27 5
## Tidak Sehat 4 25
##
## Accuracy : 0.8525
## 95% CI : (0.7383, 0.9302)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 1.821e-08
##
## Kappa : 0.7047
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8333
## Specificity : 0.8710
## Pos Pred Value : 0.8621
## Neg Pred Value : 0.8438
## Prevalence : 0.4918
## Detection Rate : 0.4098
## Detection Prevalence : 0.4754
## Balanced Accuracy : 0.8522
##
## 'Positive' Class : Tidak Sehat
## Berdasarkan hasil confusion matrix diatas, dapat diketahui bahwa kemampuan model dalam menebak target “1” atau “Sakit atau Tidak Sehat” sebesar 83.33% untuk Recall/ Sensitivity, 87.10% untuk specificity, 86.21% untuk Pos Pred Value / Precision dan 85.25% untuk Accuracy. Sehingga pada model ini bisa menebak pasien yang Tidak Sehat sebanyak 83.33%.
data_knn <- dummyVars(formula = ~target+sex+cp+fbs+exang+oldpeak+slope+ca+thal, data = jantung)
data_knn <- data.frame(predict(data_knn, newdata = jantung))
str(data_knn)## 'data.frame': 303 obs. of 25 variables:
## $ target.Sehat : num 0 0 0 0 0 0 0 0 0 0 ...
## $ target.Tidak.Sehat: num 1 1 1 1 1 1 1 1 1 1 ...
## $ sex.Female : num 0 0 1 0 1 0 1 0 0 0 ...
## $ sex.Male : num 1 1 0 1 0 1 0 1 1 1 ...
## $ cp.0 : num 0 0 0 0 1 1 0 0 0 0 ...
## $ cp.1 : num 0 0 1 1 0 0 1 1 0 0 ...
## $ cp.2 : num 0 1 0 0 0 0 0 0 1 1 ...
## $ cp.3 : num 1 0 0 0 0 0 0 0 0 0 ...
## $ fbs.False : num 0 1 1 1 1 1 1 1 0 1 ...
## $ fbs.True : num 1 0 0 0 0 0 0 0 1 0 ...
## $ exang.Tidak : num 1 1 1 1 0 1 1 1 1 1 ...
## $ exang.Iya : num 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slope.0 : num 1 1 0 0 0 0 0 0 0 0 ...
## $ slope.1 : num 0 0 0 0 0 1 1 0 0 0 ...
## $ slope.2 : num 0 0 1 1 1 0 0 1 1 1 ...
## $ ca.0 : num 1 1 1 1 1 1 1 1 1 1 ...
## $ ca.1 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ca.2 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ca.3 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ca.4 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ thal.0 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ thal.1 : num 1 0 0 0 0 1 0 0 0 0 ...
## $ thal.2 : num 0 1 1 1 1 0 1 0 0 1 ...
## $ thal.3 : num 0 0 0 0 0 0 0 1 1 0 ...data_knn$target.Sehat <- NULL
data_knn$sex.Female <- NULL
data_knn$fbs.False <- NULL
data_knn$exang.No <- NULLnames(data_knn)## [1] "target.Tidak.Sehat" "sex.Male" "cp.0"
## [4] "cp.1" "cp.2" "cp.3"
## [7] "fbs.True" "exang.Tidak" "exang.Iya"
## [10] "oldpeak" "slope.0" "slope.1"
## [13] "slope.2" "ca.0" "ca.1"
## [16] "ca.2" "ca.3" "ca.4"
## [19] "thal.0" "thal.1" "thal.2"
## [22] "thal.3"Pada kali ini saya melakukan split data train dan data test lagi akan digunakan pada klasifikasi k-nn
RNGkind(sample.kind = "Rounding") # tambahan khusus u/ R 3.6 ke atas ## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## usedset.seed(406)
intrain_knn <- sample(nrow(data_knn), nrow(data_knn)*0.8)
data_knn.train <- data_knn[intrain_knn,]
data_knn.test <- data_knn[-intrain_knn,]#prediktor
jantung.train_x <- data_knn.train %>%
select(-target.Tidak.Sehat)
jantung.test_x <- data_knn.train %>%
select(-target.Tidak.Sehat)
# target
jantung.train_y <- data_knn.train %>%
select(target.Tidak.Sehat)
jantung.test_y <- data_knn.train %>%
select(target.Tidak.Sehat)Data prediktor akan discaling menggunakan z-score standarization. Data test juga harus discalling dengan menggunakan parameter dari data train karena data test tersebut merupakan unseen data.
jantung.train_xs <- scale(jantung.train_x)
jantung.test_xs <- scale(x = jantung.test_x,
center = attr(jantung.train_xs, "scaled:center"),
scale = attr(jantung.train_xs, "scaled:scale"))Sekarang, saya akan mencari nilai untuk nilai k. Mencari nilai optimum k ini bertujuan untuk mengelompokkan jumlah tetangga terdekat.
round(sqrt(nrow(jantung.train)))## [1] 16Disini jumlah kelas target saya adalah 2 yaitu Sehat dan Tidak Sehat. Sedangkan nilai optimum k saya yaitu 16. Oleh karena itu saya menaikan nilai k menjadi 17. Dengan tujuan supaya menghindari seri.
jantung.pred <- knn(train = jantung.train_xs, test = jantung.test_xs, cl = jantung.train_y$target.Tidak.Sehat, k = 17)head(jantung.pred)## [1] 0 1 1 1 0 0
## Levels: 0 1Sekarang saya melakukan model evaluasi dengan menggunakan klasifikasi k-nn.
confusionMatrix(data = as.factor(jantung.pred), reference = as.factor(jantung.train_y$target.Tidak.Sehat), positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 80 9
## 1 27 126
##
## Accuracy : 0.8512
## 95% CI : (0.8, 0.8936)
## No Information Rate : 0.5579
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6931
##
## Mcnemar's Test P-Value : 0.004607
##
## Sensitivity : 0.9333
## Specificity : 0.7477
## Pos Pred Value : 0.8235
## Neg Pred Value : 0.8989
## Prevalence : 0.5579
## Detection Rate : 0.5207
## Detection Prevalence : 0.6322
## Balanced Accuracy : 0.8405
##
## 'Positive' Class : 1
## Berdasarkan hasil confusion matrix diatas, dapat diketahui bahwa kemampuan model dalam menebak target “1” atau “Sakit atau Tidak Sehat” sebesar 93.3% untuk Recall/ Sensitivity, 74.77% untuk specificity, 82.35% untuk Pos Pred Value / Precision dan 85.12% untuk Accuracy. Sehingga pada model ini bisa menebak pasien yang Tidak Sehat sebanyak 93.3%.
Jika saya adalah seorang dokter yang menangani penyakit jantung. Saya untuk memprediksi pasien yang mempunyai penyakit jantung atau tidak dengan melihat metric recall yang ada. Karena saya ingin mengambil sebanyak-banyaknya pasien yang Tidak Sehat dimana ketika pasien itu memang sehat akan disuruh pulang dan melakukan pemeriksaan lanjutan.