Heart Disease Classification

by Reza Syahputra

2/25/2022

Background

Penyakit jantung dan pembuluh darah atau penyakit kardiovaskular adalah berbagai kondisi di mana terjadi penyempitan atau penyumbatan pembuluh darah yang dapat menyebabkan serangan jantung, nyeri dada (angina), atau stroke. Penyakit jantung bisa terjadi kesiapa saja dan berbagai umur, jika ini terjadi, kita segera membutuhkan pertolongan medis. Namun ada beberapa hal yg harus kita jaga / kontrol agar kita bisa mendeketsi sejak dini akan kesehatan jantung kita melalui report ini akan dilakukan Klasifikasi dengan menggunakan algoritma Logistic Regression dan K-Nearest Neighbor

Import Library

Dilakukan import library yang dibutuhkan menggunakan library()

library(dplyr)
library(gtools)
library(car)
library(caret)
library(rsample)
library(ggplot2)
library(class)
library(tidyverse)
library(prettydoc)

Data Preparation

Dilakukan pembacaan dataset dan inspeksi awal

heart_main <- read.csv("heart.csv")

Data Wrangling

Cek tipe kolom

str(heart_main)
## 'data.frame':    303 obs. of  14 variables:
##  $ age     : int  63 37 41 56 57 57 56 44 52 57 ...
##  $ sex     : int  1 1 0 1 0 1 0 1 1 1 ...
##  $ cp      : int  3 2 1 1 0 0 1 1 2 2 ...
##  $ trestbps: int  145 130 130 120 120 140 140 120 172 150 ...
##  $ chol    : int  233 250 204 236 354 192 294 263 199 168 ...
##  $ fbs     : int  1 0 0 0 0 0 0 0 1 0 ...
##  $ restecg : int  0 1 0 1 1 1 0 1 1 1 ...
##  $ thalach : int  150 187 172 178 163 148 153 173 162 174 ...
##  $ exang   : int  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   : int  0 0 2 2 2 1 1 2 2 2 ...
##  $ ca      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ thal    : int  1 2 2 2 2 1 2 3 3 2 ...
##  $ target  : int  1 1 1 1 1 1 1 1 1 1 ...

Heart Disease dataset berisikan 303 observasi dan 14 kolom, dengan penjelasan kolom sebagai berikut:

  • age : Umur dalam tahun
  • sex : Jenis kelamin (1: Laki-laki, 0:Perempuan)
  • cp : Tipe chest.pain (dalam rentang 0-3)
  • trestbps : Tekanan darah dalam mm Hg pada saat masuk Rumah Sakit
  • chol : Kandungan kolesterol dalam mg/dl
  • fbs : Kadar gula darah pada saat puasa, apakah > 120 mg/dl (1:Ya, 0:Tidak)
  • restecg : Hasil elektrokardiografi (dalam rentang 0-2)
  • thalach : Denyut jantung maksimal
  • exang : exercise induced angina (1:Ya, 0:Tidak)
  • oldpeak : Depresi ST yang diinduksi oleh olahraga relatif terhadap istirahat
  • slope : kemiringan segmen ST latihan puncak, dalam rentang (0-2)
  • ca : Jumlah pembuluh darah utama, dalam rentang (0-4)
  • thal : 3:normal, 6 cacat tetap, 7:cacat yang dapat dibalik
  • target : Apakah termasuk Sakit Jantung atau Tidak, (1: Yes, 0:No)

Merubah tipe kolom

heart_main <- heart_main %>% 
  mutate(
    age = as.numeric(age),
    trestbps = as.numeric(trestbps),
    chol = as.numeric(trestbps),
    thalach = as.numeric(thalach)
    ) %>% 
  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("No", "Yes")),
    target = factor(target, levels = c(0,1), 
                        labels = c("No Heart Disease", "Heart Disease"))
  )

Check Missing Value

anyNA(heart_main)
## [1] FALSE

Exploratory Data Analysis

Menampilkan data wine yang digunakan

rmarkdown::paged_table((heart_main))

Train Test Split

Hal ini dilakukan untuk membagi dataset menjadi heart_train dan heart_test dengan porsi 80% untuk heart_train

RNGkind(sample.kind = "Rounding")
## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## used
set.seed(100)

index <- sample(nrow(heart_main),  nrow(heart_main)*0.8)
heart_train <- heart_main[index, ]
heart_test <- heart_main[-index, ]
prop.table(table(heart_train$target))
## 
## No Heart Disease    Heart Disease 
##        0.4421488        0.5578512

Logistic Regression

Base Model

Permodelan pertama dilakukan menggunakan Logistic Regression

model_log <- glm(target ~ ., 
                 data = heart_train,
                 family = "binomial")
summary(model_log)
## 
## Call:
## glm(formula = target ~ ., family = "binomial", data = heart_train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.92852  -0.24338   0.09895   0.37250   2.95963  
## 
## Coefficients: (1 not defined because of singularities)
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  6.158e-01  4.275e+00   0.144 0.885465    
## age          7.299e-04  2.833e-02   0.026 0.979447    
## sexMale     -2.118e+00  6.380e-01  -3.319 0.000902 ***
## cp1          1.753e+00  7.039e-01   2.490 0.012784 *  
## cp2          2.341e+00  6.005e-01   3.898  9.7e-05 ***
## cp3          3.931e+00  1.023e+00   3.842 0.000122 ***
## trestbps    -2.915e-02  1.381e-02  -2.111 0.034742 *  
## chol                NA         NA      NA       NA    
## fbsTrue      7.222e-01  7.037e-01   1.026 0.304775    
## restecg1     4.733e-01  4.584e-01   1.033 0.301789    
## restecg2    -6.170e-02  3.020e+00  -0.020 0.983698    
## thalach      1.101e-02  1.355e-02   0.813 0.416284    
## exangYes    -9.203e-01  5.282e-01  -1.742 0.081460 .  
## oldpeak     -7.536e-01  3.315e-01  -2.273 0.023020 *  
## slope1       1.229e+00  1.234e+00   0.996 0.319014    
## slope2       2.197e+00  1.299e+00   1.691 0.090860 .  
## ca1         -2.251e+00  5.981e-01  -3.764 0.000167 ***
## ca2         -2.886e+00  9.938e-01  -2.904 0.003682 ** 
## ca3         -1.781e+00  1.081e+00  -1.648 0.099444 .  
## ca4          1.448e+01  1.255e+03   0.012 0.990797    
## thal1        3.536e+00  3.141e+00   1.126 0.260297    
## thal2        2.206e+00  3.006e+00   0.734 0.463140    
## thal3        1.283e+00  3.011e+00   0.426 0.669914    
## ---
## 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: 135.11  on 220  degrees of freedom
## AIC: 179.11
## 
## Number of Fisher Scoring iterations: 15

Interpretasi

exp(model_log$coefficients)
##  (Intercept)          age      sexMale          cp1          cp2          cp3 
## 1.851165e+00 1.000730e+00 1.202983e-01 5.769727e+00 1.038880e+01 5.093289e+01 
##     trestbps         chol      fbsTrue     restecg1     restecg2      thalach 
## 9.712683e-01           NA 2.058939e+00 1.605276e+00 9.401622e-01 1.011072e+00 
##     exangYes      oldpeak       slope1       slope2          ca1          ca2 
## 3.984055e-01 4.706651e-01 3.418604e+00 8.996918e+00 1.052588e-01 5.579475e-02 
##          ca3          ca4        thal1        thal2        thal3 
## 1.684333e-01 1.941248e+06 3.431714e+01 9.077071e+00 3.608502e+00

Insight: Seorang Laki-laki memiliki kemungkinan penurunan sebesar 0.12 dibandingkan dengan Perempuan dengan catatan seluruh prediktor bernilai sama

Stepwise

Dilakukan stepwise modeling untuk melakukan feature selection dari beberapa prediktor

model_log_stepwise <- step(object = model_log, 
                           direction = "backward",
                           trace = 0)
summary(model_log_stepwise)
## 
## Call:
## glm(formula = target ~ sex + cp + trestbps + exang + oldpeak + 
##     ca + thal, family = "binomial", data = heart_train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.8611  -0.2768   0.1185   0.4406   2.6130  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    3.66793    4.06336   0.903 0.366694    
## sexMale       -1.61132    0.55848  -2.885 0.003912 ** 
## cp1            1.84143    0.64021   2.876 0.004024 ** 
## cp2            2.53418    0.58229   4.352 1.35e-05 ***
## cp3            3.71932    0.97680   3.808 0.000140 ***
## trestbps      -0.02325    0.01268  -1.833 0.066733 .  
## exangYes      -1.17242    0.50434  -2.325 0.020091 *  
## oldpeak       -1.13409    0.29441  -3.852 0.000117 ***
## ca1           -2.00839    0.52558  -3.821 0.000133 ***
## ca2           -2.20292    0.86226  -2.555 0.010624 *  
## ca3           -1.55944    0.99466  -1.568 0.116923    
## ca4           14.14103 1314.65290   0.011 0.991418    
## thal1          3.09829    3.82763   0.809 0.418254    
## thal2          1.99629    3.71477   0.537 0.590996    
## thal3          0.94673    3.72088   0.254 0.799158    
## ---
## 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: 142.11  on 227  degrees of freedom
## AIC: 172.11
## 
## Number of Fisher Scoring iterations: 15

Insight: Didapatkan 7 prediktor yang memiliki lebih berpengaruh terhadap kolom target

Predict

Setelah itu dilakukan predict menggunakan 2 model yang telah dibuat menggunakan fungsi predict

Prediksi Probability Heart Dissease

# Base Model
heart_test$pred_base <- predict(model_log, 
                           newdata = heart_test,
                           type = "response")
## Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == :
## prediction from a rank-deficient fit may be misleading
# Stepwise Model
heart_test$pred_step <- predict(model_log_stepwise,
                           newdata = heart_test,
                           type = "response")

Klasifikasi Berdasarkan Probablity

# Base Model
heart_test$label_base <- ifelse(heart_test$pred_base > 0.5, "Heart Disease", "No Heart Disease") %>% 
  as.factor()

# Stepwise Model
heart_test$label_step <- ifelse(heart_test$pred_step > 0.5, "Heart Disease", "No Heart Disease") %>% 
  as.factor()

Model Evaluation

Confussion Matrix

Base Model

confusionMatrix(data = heart_test$label_base,
                reference = heart_test$target,
                positive = "Heart Disease")
## Warning in confusionMatrix.default(data = heart_test$label_base, reference =
## heart_test$target, : Levels are not in the same order for reference and data.
## Refactoring data to match.
## Confusion Matrix and Statistics
## 
##                   Reference
## Prediction         No Heart Disease Heart Disease
##   No Heart Disease               23             7
##   Heart Disease                   8            23
##                                           
##                Accuracy : 0.7541          
##                  95% CI : (0.6271, 0.8554)
##     No Information Rate : 0.5082          
##     P-Value [Acc > NIR] : 7.39e-05        
##                                           
##                   Kappa : 0.5083          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.7667          
##             Specificity : 0.7419          
##          Pos Pred Value : 0.7419          
##          Neg Pred Value : 0.7667          
##              Prevalence : 0.4918          
##          Detection Rate : 0.3770          
##    Detection Prevalence : 0.5082          
##       Balanced Accuracy : 0.7543          
##                                           
##        'Positive' Class : Heart Disease   
##

Stepwise Model

confusionMatrix(data = heart_test$label_step,
                reference = heart_test$target,
                positive = "Heart Disease")
## Warning in confusionMatrix.default(data = heart_test$label_step, reference =
## heart_test$target, : Levels are not in the same order for reference and data.
## Refactoring data to match.
## Confusion Matrix and Statistics
## 
##                   Reference
## Prediction         No Heart Disease Heart Disease
##   No Heart Disease               23             7
##   Heart Disease                   8            23
##                                           
##                Accuracy : 0.7541          
##                  95% CI : (0.6271, 0.8554)
##     No Information Rate : 0.5082          
##     P-Value [Acc > NIR] : 7.39e-05        
##                                           
##                   Kappa : 0.5083          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.7667          
##             Specificity : 0.7419          
##          Pos Pred Value : 0.7419          
##          Neg Pred Value : 0.7667          
##              Prevalence : 0.4918          
##          Detection Rate : 0.3770          
##    Detection Prevalence : 0.5082          
##       Balanced Accuracy : 0.7543          
##                                           
##        'Positive' Class : Heart Disease   
##

Insight: 1. Dari Confusion Matrix yang dihasilkan menunjukkan bahwa kedua model memberikan hasil Klasifikasi yang sama. 2. Terlihat bahwa model sudah dapat cukup baik dari segi akurasi dalam melakukan Klasifikasi, pada kasus ini akan digunakan matriks Recall yang diketahui bahwa nilai matriks tersebut cukup rendah 3. Akan digunakan model dari Stepwise karena prediktor yang digunakan lebih sedikit dan memberikan performa yang sama dengan model base

Model Improvement: Merubah nilai threshold

# Dari beberapa kali percobaan didapatkan nilai threshold yang mampu menurunkan recall adalah 0.4
heart_test$label_step <- ifelse(heart_test$pred_step > 0.4, "Heart Disease", "No Heart Disease") %>% 
  as.factor()

confusionMatrix(data = heart_test$label_step,
                reference = heart_test$target,
                positive = "Heart Disease")
## Warning in confusionMatrix.default(data = heart_test$label_step, reference =
## heart_test$target, : Levels are not in the same order for reference and data.
## Refactoring data to match.
## Confusion Matrix and Statistics
## 
##                   Reference
## Prediction         No Heart Disease Heart Disease
##   No Heart Disease               23             5
##   Heart Disease                   8            25
##                                           
##                Accuracy : 0.7869          
##                  95% CI : (0.6632, 0.8814)
##     No Information Rate : 0.5082          
##     P-Value [Acc > NIR] : 6.823e-06       
##                                           
##                   Kappa : 0.5743          
##                                           
##  Mcnemar's Test P-Value : 0.5791          
##                                           
##             Sensitivity : 0.8333          
##             Specificity : 0.7419          
##          Pos Pred Value : 0.7576          
##          Neg Pred Value : 0.8214          
##              Prevalence : 0.4918          
##          Detection Rate : 0.4098          
##    Detection Prevalence : 0.5410          
##       Balanced Accuracy : 0.7876          
##                                           
##        'Positive' Class : Heart Disease   
##

Insight: Dengan menurunkan nilai threshold menjadi 0.4 didapatkan performa akurasi menjadi 78.68% dengan matriks recal meningkat menjadi 83.33% dan precission meningkat menjadi 75.76%

KNN

Data Preprocessing

Pembuatan data dummy untuk beberapa prediktor dengan tipe kategori

dmy <- dummyVars(~. , data = heart_main)
dmy <- data.frame(predict(dmy, newdata = heart_main))
str(dmy)
## 'data.frame':    303 obs. of  32 variables:
##  $ age                    : num  63 37 41 56 57 57 56 44 52 57 ...
##  $ 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 ...
##  $ trestbps               : num  145 130 130 120 120 140 140 120 172 150 ...
##  $ chol                   : num  145 130 130 120 120 140 140 120 172 150 ...
##  $ 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 ...
##  $ restecg.0              : num  1 0 1 0 0 0 1 0 0 0 ...
##  $ restecg.1              : num  0 1 0 1 1 1 0 1 1 1 ...
##  $ restecg.2              : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ thalach                : num  150 187 172 178 163 148 153 173 162 174 ...
##  $ exang.No               : num  1 1 1 1 0 1 1 1 1 1 ...
##  $ exang.Yes              : 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 ...
##  $ target.No.Heart.Disease: num  0 0 0 0 0 0 0 0 0 0 ...
##  $ target.Heart.Disease   : num  1 1 1 1 1 1 1 1 1 1 ...

Menghilangkan kolom yang hanya terdiri dari 2 kategori

dmy$sex.Female <- NULL
dmy$fbs.False <- NULL
dmy$exang.No <- NULL
dmy$target.No.Heart.Disease <- NULL

Menampilkan prediktor akhir

names(dmy)
##  [1] "age"                  "sex.Male"             "cp.0"                
##  [4] "cp.1"                 "cp.2"                 "cp.3"                
##  [7] "trestbps"             "chol"                 "fbs.True"            
## [10] "restecg.0"            "restecg.1"            "restecg.2"           
## [13] "thalach"              "exang.Yes"            "oldpeak"             
## [16] "slope.0"              "slope.1"              "slope.2"             
## [19] "ca.0"                 "ca.1"                 "ca.2"                
## [22] "ca.3"                 "ca.4"                 "thal.0"              
## [25] "thal.1"               "thal.2"               "thal.3"              
## [28] "target.Heart.Disease"

Train Test Split

set.seed(100)
dmy_train <- dmy[index, ]
dmy_test <- dmy[-index, ]

K Optimum

sqrt(nrow(dmy_train))
## [1] 15.55635

Modeling

dmy_pred <- knn(train = dmy_train %>% select(-target.Heart.Disease) ,
                test = dmy_test %>% select(-target.Heart.Disease),
                cl = dmy_train$target.Heart.Disease,
                k = 15
                )

Model Evaluation

confusionMatrix(data = dmy_pred %>% as.factor(),
                reference = dmy_test$target.Heart.Disease %>% as.factor(),
                positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 19  6
##          1 12 24
##                                           
##                Accuracy : 0.7049          
##                  95% CI : (0.5743, 0.8148)
##     No Information Rate : 0.5082          
##     P-Value [Acc > NIR] : 0.001424        
##                                           
##                   Kappa : 0.4116          
##                                           
##  Mcnemar's Test P-Value : 0.238593        
##                                           
##             Sensitivity : 0.8000          
##             Specificity : 0.6129          
##          Pos Pred Value : 0.6667          
##          Neg Pred Value : 0.7600          
##              Prevalence : 0.4918          
##          Detection Rate : 0.3934          
##    Detection Prevalence : 0.5902          
##       Balanced Accuracy : 0.7065          
##                                           
##        'Positive' Class : 1               
##

Insight: 1. Dari model evaluasi yang dilakukan akurasi menurun, namun dari matriks Recall menunjukkan perbaikan, dan hal ini menunjukkan model lebih baik dalam mengklasifikasikan Heart Disease agar terhindar dari tindakan yang tidak diinginkan

##Model Improvement: Merubah nilai K

# Mencoba menaikkan nilai K menjadi 17
dmy_pred <- knn(train = dmy_train %>% select(-target.Heart.Disease) ,
                test = dmy_test %>% select(-target.Heart.Disease),
                cl = dmy_train$target.Heart.Disease,
                k = 17
                )

confusionMatrix(data = dmy_pred %>% as.factor(),
                reference = dmy_test$target.Heart.Disease %>% as.factor(),
                positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 20  4
##          1 11 26
##                                           
##                Accuracy : 0.7541          
##                  95% CI : (0.6271, 0.8554)
##     No Information Rate : 0.5082          
##     P-Value [Acc > NIR] : 7.39e-05        
##                                           
##                   Kappa : 0.5099          
##                                           
##  Mcnemar's Test P-Value : 0.1213          
##                                           
##             Sensitivity : 0.8667          
##             Specificity : 0.6452          
##          Pos Pred Value : 0.7027          
##          Neg Pred Value : 0.8333          
##              Prevalence : 0.4918          
##          Detection Rate : 0.4262          
##    Detection Prevalence : 0.6066          
##       Balanced Accuracy : 0.7559          
##                                           
##        'Positive' Class : 1               
##

Insight: Terjadi peningkatan performa pada nilai akurasi dan matriks Recall yang menunjukkan model lebih baik dalam melakukan klasifikasi

Kesimpulan

Dari beberapa percobaan diatas menunjukkan bahwa Klasifikasi Heart Disease menggunakan algoritma Logistic Regression memberikan performa yang cukup baik. Model tersebut dapat digunakan sebagai screening awal pasien untuk mengelompokkan apakah seorang pasien mengalami Heart Disease atau tidak. Tentu hasil dari klasifikasi tersebut perlu penanganan dan pengecekkan lebih lanjut sehingga evaluasi model dapat menggunakan matriks Recall untuk menurunkan kemungkinan salah prediksi Not Heart Disease padahal sebenarnya adalah Heart Disease. Selain matriks recall performa Akurasi juga cukup baik walaupun hanya 78% hal ini dapat dikatakan wajar karena jumlah data observasi yang tergolong sedikit hanya sekitar 303 observasi.