Berikut adalah analisis mengenai data Heart Disease pada sebuah populasi. Data ini menunjukan pengaruh beragam parameter aspek kesehatan yang nantinya mempengaruhi apakah pasien ini berpotensi terkena Heart Attack atau tidak. Pada kali ini kita akan mencoba mengidentifikasi pasien yang menunjukkan tanda-tanda menderita serangan jantung dengan menggunakan model logistic regression & k-nearest neighbor
Sebelum kita melakukan pemodelan terhadap data maka kita harus melakukan install.package() yang di butuhkan pada R Studio. Apabila telah ter-install, maka lakukan pengaktifan package menggunakan library().
library(dplyr)
library(gtools)
library(gmodels)
library(ggplot2)
library(class)
library(tidyr)
library(rsample)
library(caret)
library(MASS)
Dataset yang akan saya gunakan yaitu data mengenai pasien yang terkena penyakit jantung berdasarkan beberapa karakteristik yang menyertai yang dapat Anda unduh lansung pada https://www.kaggle.com/ronitf/heart-disease-uci.
heart <- read.csv("data_input/heart.csv")
glimpse(heart)
## Rows: 303
## Columns: 14
## $ ï..age <int> 63, 37, 41, 56, 57, 57, 56, 44, 52, 57, 54, 48, 49, 64, 58, 5~
## $ sex <int> 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1~
## $ cp <int> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3, 0~
## $ trestbps <int> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130, 1~
## $ chol <int> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275, 2~
## $ fbs <int> 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 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, 1~
## $ thalach <int> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139, 1~
## $ exang <int> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 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, 0~
## $ slope <int> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2, 1~
## $ ca <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0~
## $ thal <int> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3~
## $ target <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
ï..age : dalam beberapa tahun
sex : (1 = laki-laki; 0 = perempuan)
cp : tipe nyeri yang paling parah
trestbps : melacak tekanan darah(dalam mm Hg saat masuk ke rumah sakit)
chol : kolestoral dalam mg / dl
fbs : (gula darah puasa> 120 mg / dl) (1 = benar; 0 = salah)
restecg : mengembalikan hasil elektrokardiografi
thalach : denyut jantung maksimum tercapai
exang : exercise induced angina (1 = ya; 0 = tidak)
oldpeak : ST depresi yang disebabkan oleh olahraga relatif terhadap istirahat
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 atau 0 = tidak sakit
Berikut ini gambaran sedikit pada data yang digunakan.
head(heart)
Pada beberapa variabel yang digunakan, terdapat ketidak sesuaian tipe data, oleh karena itu yang perlu kita lakukan adalah melakukan penyesuaian tipe data pada beberapa variabel yang ada.
heart <- heart %>%
mutate( sex = as.factor(sex),
cp = as.factor(cp),
fbs = as.factor(fbs),
restecg = as.factor(restecg),
exang = as.factor(exang),
slope = as.factor(slope),
ca = as.factor(ca),
thal = as.factor(thal),
target = as.factor(target))
glimpse(heart)
## Rows: 303
## Columns: 14
## $ ï..age <int> 63, 37, 41, 56, 57, 57, 56, 44, 52, 57, 54, 48, 49, 64, 58, 5~
## $ sex <fct> 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1~
## $ cp <fct> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3, 0~
## $ trestbps <int> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130, 1~
## $ chol <int> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275, 2~
## $ fbs <fct> 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0~
## $ restecg <fct> 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1~
## $ thalach <int> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139, 1~
## $ exang <fct> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 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, 0~
## $ slope <fct> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2, 1~
## $ ca <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0~
## $ thal <fct> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3~
## $ target <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
Selanjutnya yaitu melakukan pengecekan terhadap missing value. Missing value perlu kita cek terlebih dahulu agar tidak mengganggu dalam melakukan pemodelan nantinya.
colSums(is.na(heart))
## ï..age sex cp trestbps chol fbs restecg thalach
## 0 0 0 0 0 0 0 0
## exang oldpeak slope ca thal target
## 0 0 0 0 0 0
anyNA(heart)
## [1] FALSE
Terlihat di atas untuk data kita sudah tidak ada yang missing value. Dan kita bisa lanjut ke tahap berikutnya.
Sebelum melakukan pemodelan, kita perlu melihat terlebih dahulu proporsi dari target variabel yang kita miliki pada kolom target.
prop.table(table(heart$target))
##
## 0 1
## 0.4554455 0.5445545
table(heart$target)
##
## 0 1
## 138 165
Jika dilihat dari proporsi kedua kelas, sudah cukup seimbang, sehingga kita tidak terlalu membutuhkan pre-processing tambahan untuk menyeimbangkan proporsi antar dua kelas target variabel.
Langkah selanjutnya yaitu melakukan splitting train test data. Tujuannya yaitu pada data train akan kita gunakan untuk modeling, sedangkan data test akan kita gunakan sebagai penguji model yang sudah kita buat jika dihadapkan dengan unseen data. Selain itu hal ini dapat digunakan untuk melihat kemampuan model yang kita buat dalam menghadapi unseen data.
RNGkind(sample.kind = "Rounding") # tambahan khusus u/ R 3.6 ke atas
set.seed(417) # mengunci random number yang dipilih
intrain <- sample(nrow(heart), nrow(heart)*0.8)
heart_train <- heart[intrain,]
heart_test <- heart[-intrain,]
Melakukan pemodelan menggunakan regresi logistik. Pemodelan menggunakan fungsi glm() dalam memodelkan menggunakan regresi logistik. Variabel yang digunakan adalah beberapa variabel yang kita anggap mempengaruhi target variabel, dimana variabel target menjadi variabel responnya.
#Kita akan membuat model dengan memasukkan semua kolom selain `terget` menjadi prediktor
model <- glm(formula = target ~ . , data = heart_train, family = "binomial")
summary(model)
##
## Call:
## glm(formula = target ~ ., family = "binomial", data = heart_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.94059 -0.28409 0.07096 0.38869 2.14532
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.435319 4.340647 -0.100 0.92012
## ï..age 0.016942 0.029094 0.582 0.56035
## sex1 -2.071548 0.695949 -2.977 0.00291 **
## cp1 1.081858 0.711613 1.520 0.12844
## cp2 2.322908 0.654949 3.547 0.00039 ***
## cp3 2.253059 0.858425 2.625 0.00867 **
## trestbps -0.022691 0.013947 -1.627 0.10375
## chol -0.005280 0.004997 -1.057 0.29060
## fbs1 0.460707 0.716181 0.643 0.52004
## restecg1 0.552222 0.474611 1.164 0.24462
## restecg2 -0.715905 2.807326 -0.255 0.79871
## thalach 0.029500 0.014980 1.969 0.04892 *
## exang1 -1.218681 0.555298 -2.195 0.02819 *
## oldpeak -0.342569 0.283226 -1.210 0.22646
## slope1 -1.231286 1.174861 -1.048 0.29463
## slope2 0.652243 1.250639 0.522 0.60200
## ca1 -2.983688 0.644070 -4.633 3.61e-06 ***
## ca2 -4.599470 1.032991 -4.453 8.48e-06 ***
## ca3 -2.477866 1.018411 -2.433 0.01497 *
## ca4 1.329706 1.935483 0.687 0.49207
## thal1 3.387735 3.205669 1.057 0.29061
## thal2 2.490137 3.092638 0.805 0.42071
## thal3 1.120725 3.101863 0.361 0.71787
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 334.14 on 241 degrees of freedom
## Residual deviance: 131.96 on 219 degrees of freedom
## AIC: 177.96
##
## Number of Fisher Scoring iterations: 7
Pada pemodelan yang pertama kita mengambil semua kolom selain target untuk menjadi prediktor nya. Oleh karena itu pada model fitting ini kita coba melakukan pemilihan kolom prediktor menggunakan metode stepwise
model2 <- stepAIC(model, direction = "backward")
## Start: AIC=177.96
## target ~ ï..age + sex + cp + trestbps + chol + fbs + restecg +
## thalach + exang + oldpeak + slope + ca + thal
##
## Df Deviance AIC
## - restecg 2 133.45 175.45
## - ï..age 1 132.30 176.30
## - fbs 1 132.38 176.38
## - chol 1 133.02 177.02
## - oldpeak 1 133.48 177.48
## <none> 131.96 177.96
## - trestbps 1 134.72 178.72
## - thalach 1 136.39 180.39
## - exang 1 136.89 180.89
## - thal 3 142.40 182.40
## - slope 2 143.16 185.16
## - sex 1 141.97 185.97
## - cp 3 148.82 188.82
## - ca 4 179.43 217.43
##
## Step: AIC=175.45
## target ~ ï..age + sex + cp + trestbps + chol + fbs + thalach +
## exang + oldpeak + slope + ca + thal
##
## Df Deviance AIC
## - ï..age 1 133.75 173.75
## - fbs 1 133.93 173.93
## - oldpeak 1 134.93 174.93
## - chol 1 135.17 175.17
## <none> 133.45 175.45
## - trestbps 1 136.88 176.88
## - thalach 1 137.93 177.93
## - exang 1 138.10 178.10
## - thal 3 143.07 179.07
## - slope 2 145.22 183.22
## - sex 1 144.43 184.43
## - cp 3 150.31 186.31
## - ca 4 181.18 215.18
##
## Step: AIC=173.75
## target ~ sex + cp + trestbps + chol + fbs + thalach + exang +
## oldpeak + slope + ca + thal
##
## Df Deviance AIC
## - fbs 1 134.20 172.20
## - oldpeak 1 135.31 173.31
## - chol 1 135.38 173.38
## <none> 133.75 173.75
## - trestbps 1 136.88 174.88
## - thalach 1 137.97 175.97
## - exang 1 138.60 176.60
## - thal 3 143.45 177.45
## - slope 2 145.37 181.37
## - sex 1 145.03 183.03
## - cp 3 150.78 184.78
## - ca 4 182.97 214.97
##
## Step: AIC=172.2
## target ~ sex + cp + trestbps + chol + thalach + exang + oldpeak +
## slope + ca + thal
##
## Df Deviance AIC
## - chol 1 135.64 171.64
## - oldpeak 1 135.89 171.89
## <none> 134.20 172.20
## - trestbps 1 137.13 173.13
## - thalach 1 138.34 174.34
## - exang 1 138.72 174.72
## - thal 3 144.52 176.52
## - slope 2 145.39 179.39
## - sex 1 145.03 181.03
## - cp 3 152.87 184.87
## - ca 4 183.06 213.06
##
## Step: AIC=171.64
## target ~ sex + cp + trestbps + thalach + exang + oldpeak + slope +
## ca + thal
##
## Df Deviance AIC
## - oldpeak 1 137.59 171.59
## <none> 135.64 171.64
## - trestbps 1 139.07 173.07
## - thalach 1 139.09 173.09
## - exang 1 140.33 174.33
## - thal 3 146.53 176.53
## - slope 2 147.18 179.18
## - sex 1 145.19 179.19
## - cp 3 154.63 184.63
## - ca 4 185.56 213.56
##
## Step: AIC=171.59
## target ~ sex + cp + trestbps + thalach + exang + slope + ca +
## thal
##
## Df Deviance AIC
## <none> 137.59 171.59
## - trestbps 1 141.18 173.18
## - thalach 1 141.39 173.39
## - exang 1 142.78 174.78
## - thal 3 148.84 176.84
## - sex 1 147.49 179.49
## - slope 2 152.99 182.99
## - cp 3 155.78 183.78
## - ca 4 191.98 217.98
Dengan menggunakan metode backward pada stepwise, kita memperoleh model sebagai berikut.
summary(model2)
##
## Call:
## glm(formula = target ~ sex + cp + trestbps + thalach + exang +
## slope + ca + thal, family = "binomial", data = heart_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.93413 -0.27363 0.07124 0.37508 2.11624
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.55786 4.54776 -0.123 0.902371
## sex1 -1.89609 0.64079 -2.959 0.003087 **
## cp1 1.25096 0.69705 1.795 0.072708 .
## cp2 2.40113 0.64668 3.713 0.000205 ***
## cp3 2.12390 0.81513 2.606 0.009171 **
## trestbps -0.02279 0.01233 -1.848 0.064534 .
## thalach 0.02431 0.01324 1.836 0.066330 .
## exang1 -1.20845 0.53547 -2.257 0.024019 *
## slope1 -0.52100 0.94624 -0.551 0.581908
## slope2 1.58712 0.98648 1.609 0.107644
## ca1 -2.91998 0.62354 -4.683 2.83e-06 ***
## ca2 -4.38372 0.94062 -4.660 3.15e-06 ***
## ca3 -2.60980 0.95458 -2.734 0.006257 **
## ca4 1.66614 1.83606 0.907 0.364168
## thal1 2.96444 3.95135 0.750 0.453113
## thal2 2.10669 3.86836 0.545 0.586033
## thal3 0.73313 3.86960 0.189 0.849733
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 334.14 on 241 degrees of freedom
## Residual deviance: 137.59 on 225 degrees of freedom
## AIC: 171.59
##
## Number of Fisher Scoring iterations: 6
Dari 2 model yang sudah kita coba buat maka di dapatkan model2 lah yang pelaing baik bila dibanding dengan model. karena nilai AIC lebih kecil yaitu 171.59
Dengan menggunakan model2 hasil dari stepwise, kita akan coba prediksi menggunakan data test yang sudah kita miliki.
heart_test$pred.risk <- predict(object = model2, type = "response", newdata = heart_test)
head(heart_test)
Selanjutnya kita akan klasifikasikan data heart_test berdasarkan pred.risk dan simpan pada kolom baru bernama pred.label. pada fungsi ifelse kita akan mengklasifikasikan bahwa pred.risk > 0.5 maka akan di beri label 1 (yang artinya pasien terkena penyakit jantung)
# ifelse(kondisi, benar, salah)
heart_test$pred.label <- ifelse(heart_test$pred.risk > 0.5 ,1, 0)
# pastikan kelas target (aktual dan prediksi) bertipe factor
heart_test$pred.label <- as.factor(heart_test$pred.label)
glimpse(heart_test)
## Rows: 61
## Columns: 16
## $ ï..age <int> 37, 57, 64, 51, 65, 51, 46, 44, 63, 71, 51, 45, 44, 29, 55,~
## $ sex <fct> 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0,~
## $ cp <fct> 2, 2, 3, 2, 2, 3, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 2, 2, 2, 1,~
## $ trestbps <int> 130, 150, 110, 110, 140, 125, 142, 108, 135, 110, 100, 130,~
## $ chol <int> 250, 168, 211, 175, 417, 213, 177, 141, 252, 265, 222, 234,~
## $ fbs <fct> 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,~
## $ restecg <fct> 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0,~
## $ thalach <int> 187, 174, 144, 123, 157, 125, 160, 175, 172, 130, 143, 175,~
## $ exang <fct> 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1,~
## $ oldpeak <dbl> 3.5, 1.6, 1.8, 0.6, 0.8, 1.4, 1.4, 0.6, 0.0, 0.0, 1.2, 0.6,~
## $ slope <fct> 0, 2, 1, 2, 2, 2, 0, 1, 2, 2, 1, 1, 2, 2, 1, 2, 1, 2, 2, 2,~
## $ ca <fct> 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 4, 1,~
## $ thal <fct> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, 2,~
## $ target <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,~
## $ pred.risk <dbl> 0.97433714, 0.98847874, 0.73896282, 0.98407619, 0.96241146,~
## $ pred.label <fct> 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,~
Dalam syntax diatas, ketika probabilitas data test lebih dari 0.5, artinya dia terkena penyakit Jantung.
Untuk mengevaluasi model yang telah kita buat, kita akan menggunakan confusion matrix.
log_conf <- confusionMatrix(heart_test$pred.label, heart_test$target, positive = "1")
log_conf
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 19 4
## 1 7 31
##
## Accuracy : 0.8197
## 95% CI : (0.7002, 0.9064)
## No Information Rate : 0.5738
## P-Value [Acc > NIR] : 4.229e-05
##
## Kappa : 0.6258
##
## Mcnemar's Test P-Value : 0.5465
##
## Sensitivity : 0.8857
## Specificity : 0.7308
## Pos Pred Value : 0.8158
## Neg Pred Value : 0.8261
## Prevalence : 0.5738
## Detection Rate : 0.5082
## Detection Prevalence : 0.6230
## Balanced Accuracy : 0.8082
##
## 'Positive' Class : 1
##
Re-call/Sensitivity = dari semua data aktual yang positif, seberapa mampu proporsi model saya menebak benar.
Specificity = dari semua data aktual yang negatif, seberapa mampu proporsi model saya menebak yang benar.
Accuracy = seberapa mampu model saya menebak dengan benar target Y.
Precision = dari semua hasil prediksi, seberapa mampu model saya dapat menebak benar kelas positif.
Berdasarkan hasil confusionMatrix diatas, dapat kita ambil informasi bahwa kemampuan model dalam menebak target Y (1 = terkena penyakit jantung, 0 = sehat) sebesar 81,97%.
Sensitivity : 88.57%
Specificity : 73.08%
Pos Pred Value : 81.58%
Pre-Processing Data Kita akan melakukan import data kembali.
dt_heart <- read.csv("data_input/heart.csv")
glimpse(dt_heart)
## Rows: 303
## Columns: 14
## $ ï..age <int> 63, 37, 41, 56, 57, 57, 56, 44, 52, 57, 54, 48, 49, 64, 58, 5~
## $ sex <int> 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1~
## $ cp <int> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3, 0~
## $ trestbps <int> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130, 1~
## $ chol <int> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275, 2~
## $ fbs <int> 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 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, 1~
## $ thalach <int> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139, 1~
## $ exang <int> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 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, 0~
## $ slope <int> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2, 1~
## $ ca <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0~
## $ thal <int> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3~
## $ target <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
lalu selanjutnya kita akan mengganti tipe data dari kolom target menjadi factor.
dt_heart <- dt_heart %>%
mutate( target = as.factor(target))
glimpse(dt_heart)
## Rows: 303
## Columns: 14
## $ ï..age <int> 63, 37, 41, 56, 57, 57, 56, 44, 52, 57, 54, 48, 49, 64, 58, 5~
## $ sex <int> 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1~
## $ cp <int> 3, 2, 1, 1, 0, 0, 1, 1, 2, 2, 0, 2, 1, 3, 3, 2, 2, 3, 0, 3, 0~
## $ trestbps <int> 145, 130, 130, 120, 120, 140, 140, 120, 172, 150, 140, 130, 1~
## $ chol <int> 233, 250, 204, 236, 354, 192, 294, 263, 199, 168, 239, 275, 2~
## $ fbs <int> 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 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, 1~
## $ thalach <int> 150, 187, 172, 178, 163, 148, 153, 173, 162, 174, 160, 139, 1~
## $ exang <int> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 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, 0~
## $ slope <int> 0, 0, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1, 2, 0, 2, 2, 1~
## $ ca <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0~
## $ thal <int> 1, 2, 2, 2, 2, 1, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3~
## $ target <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
setelah itu kita lanjut ke tahapan cross validation
RNGkind(sample.kind = "Rounding")
set.seed(417)
init <- initial_split(data = dt_heart, prop = 0.8, strata = "target")
dt_heart_train <- training(init)
dt_heart_test <- testing(init)
Tidak lupa kita lakukan pengecekan apakah datanya sudah balance atau belum.
# recheck class balance
prop.table(table(dt_heart_train$target))
##
## 0 1
## 0.454918 0.545082
prop.table(table(dt_heart_test$target))
##
## 0 1
## 0.4576271 0.5423729
Selanjutnya kita akan memisahkan antara prediktor dan target variabelnya
# prediktor
# ini sama aja kita milih kolom apa aja yang jadi prediktor
dt_heart_train_x <- dt_heart_train %>%
dplyr::select(-target)
dt_heart_test_x <- dt_heart_test %>%
dplyr::select(-target)
# target
# ini kita milih target variabel
dt_heart_train_y <- dt_heart_train %>%
dplyr::select(target)
dt_heart_test_y <- dt_heart_test %>%
dplyr::select(target)
Data prediktor akan discaling menggunakan z-score standarization. Data test juga harus discaling menggunakan parameter dari data train (karena menganggap data test adalah unseen data).
# scaling data prediktor
dt_heart_train_xs <- scale(dt_heart_train_x)
dt_heart_test_xs <- scale(dt_heart_test_x)
Selanjutnya kita akan menentukan nilai optimun dari K
sqrt(nrow(dt_heart_train_xs))
## [1] 15.6205
Selanjutnya kita akan melakukan predict
#knn(data training, data yang kita predict, kelas data training , jumlah K)
dt_heart_pred <- knn(train = dt_heart_train_xs, test = dt_heart_test_xs, cl = dt_heart_train_y$target, k = 15)
head(dt_heart_pred)
## [1] 1 1 1 1 1 1
## Levels: 0 1
Membuat confusion matriks dari prediski K-NN
pred_knn_conf <- confusionMatrix(data = dt_heart_pred, reference = as.factor(dt_heart_test_y$target), positive = "1")
pred_knn_conf
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 20 2
## 1 7 30
##
## Accuracy : 0.8475
## 95% CI : (0.7301, 0.9278)
## No Information Rate : 0.5424
## P-Value [Acc > NIR] : 7.195e-07
##
## Kappa : 0.6882
##
## Mcnemar's Test P-Value : 0.1824
##
## Sensitivity : 0.9375
## Specificity : 0.7407
## Pos Pred Value : 0.8108
## Neg Pred Value : 0.9091
## Prevalence : 0.5424
## Detection Rate : 0.5085
## Detection Prevalence : 0.6271
## Balanced Accuracy : 0.8391
##
## 'Positive' Class : 1
##
Berdasarkan hasil confusion matrix diatas, dapat kita ketahui bahwa kemampuan model dalam menebak target Y sebesar 84.75%.
Sensitivity : 93.75%
Specificity : 74.07%
Pos Pred Value : 81.08%
eval_logit <- data_frame(Accuracy = log_conf$overall[1],
Recall = log_conf$byClass[1],
Specificity = log_conf$byClass[2],
Precision = log_conf$byClass[3])
eval_knn <- data_frame(Accuracy = pred_knn_conf$overall[1],
Recall = pred_knn_conf$byClass[1],
Specificity = log_conf$byClass[2],
Precision = pred_knn_conf$byClass[3])
# Model Evaluation Logit
eval_logit
# Model Evaluation K-NN
eval_knn
Jika dilihat dari kedua metode tersebut, yaitu dengan menggunakan Regresi Logistik dan K-NN, kemampupuan model dalam memprediksi benar dari data aktual orang yang terkena penyakit jantung (target = 1) lebih baik dengan menggunakan metode K-NN karena memiliki nilai Accuracy = 84.74% lebih besar dari pada menggunakan metode regresi logistik.
Jika saya mengibaratkan diri saya seorang dokter penyakit jantung, dimana treatment yang akan saya lakukan ke pasien saya yang sakit jantung dengan yang tidak sakit jantung sangat berbeda. Jadi saya akan lebih mementingkan nilai Sensitivity (Recall) karena saya ingin memperkecil peluang pasien yang di prediksi tidak sakit padahal dia sakit. Mengingat penyakit jantung ini adalah salah satu penyakit yang mematikan maka akan lebih baik jika di ketahui lebih awal dan segera di lakukan penanganan awal sesuai dengan keilmuan kesehatan.