Selesai, mari lanjutkan ke langkah berikutnya

str(heart)

#> '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 ...

Wah sepertinya banyak kolom yang sifat nya diskrit, mari kita ubah ke dalam bentuk factor

Yeayy tipe data nya sekarang sudah benar

Cek Mising Values

anyNA(heart)

#> [1] FALSE

Sepertinya di keseluruhan dataset kita tidak terdapat Missing Values :D

Cek Outlier

# cek outlier
library(tidyverse)
heart %>%
  select(-target) %>% 
  boxplot

Terlihat pada kolom Chol memiliki Outlier yang paling banyak, tetapi bukan berarti Outlier yang terdapat di data kita harus serta merta di hapus, perlu analisa lebih lanjut. Dari hasil model yang kita buat nanti akan kita putuskan apakah dengan menghapus Outlier tingkat akurasi model kita meningkat atau tidak.

Cek duplikasi Data

duplicated(heart)

#>   [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [49] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [73] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [85] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [97] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [109] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [121] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [133] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [145] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [157] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE
#> [169] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [181] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [193] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [205] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [217] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [229] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [241] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [253] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [265] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [277] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [289] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [301] FALSE FALSE FALSE

heart[duplicated(heart)
,]

#>     age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
#> 165  38   1  2      138  175   0       1     173     0       0     2  4    2
#>     target
#> 165      1

Pengecekan Duplikasi data kita lakukan karena salah satu asumsi dari pada Logistic Regression ialah Independence of Observations yang artinya antar observasi saling independen & tidak berasal dari pengukuran berulang (repeated measurement). Tetapi karena disini hanya satu saja duplikasi data yang kita miliki saya asumsikan data duplikasi nya tidak perlu di hapus karena bisa jadi ini merupakan data yang tidak secara sengaja sama

Cek Proporsi Kelas Target

prop.table(table(heart$target))

#> 
#>         0         1 
#> 0.4554455 0.5445545

Proporsi kelas target nya sudah cukup balance karena tidak berbeda secara extreme signifikan. Tujuan membalance kan variable target ialah agar model kita dapat secara merata / maksimal belajar di kedua kelas (positif / negatif)

Aman masih balance :)

Dari hasil Summary Model kita di atas dapat kita simpulkan bahwa banyak prediktor variable yang tidak signifikan mempengaruhi target variable jika di perhatikan dari p-value nya, walaupun jika di lihat dari Residual Deviance nya cukup kecil

Model Feature Selection menggunakan Stepwise akan kita lakukan guna menseleksi variable prediktor yang signifikan mempengaruhi variable target

model_step <- step(model_heart, director = "backward", trace = F)
summary(model_step)

#> 
#> Call:
#> glm(formula = target ~ sex + cp + trestbps + restecg + exang + 
#>     slope + ca + thal, family = "binomial", data = heart_log_train)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -3.1105  -0.2909   0.0779   0.4125   2.9766  
#> 
#> Coefficients:
#>             Estimate Std. Error z value  Pr(>|z|)    
#> (Intercept)  1.28957    3.85756   0.334  0.738155    
#> sex1        -1.86680    0.65240  -2.861  0.004218 ** 
#> cp1          1.52414    0.70275   2.169  0.030096 *  
#> cp2          2.13444    0.58958   3.620  0.000294 ***
#> cp3          2.94758    0.83834   3.516  0.000438 ***
#> trestbps    -0.01985    0.01314  -1.511  0.130847    
#> restecg1     0.84631    0.46948   1.803  0.071441 .  
#> restecg2    -1.51197    2.07917  -0.727  0.467106    
#> exang1      -0.80632    0.51154  -1.576  0.114967    
#> slope1       0.13132    0.88952   0.148  0.882635    
#> slope2       2.06320    0.93499   2.207  0.027338 *  
#> ca1         -2.20116    0.58150  -3.785  0.000154 ***
#> ca2         -3.80848    0.91621  -4.157 0.0000323 ***
#> ca3         -2.01801    0.93290  -2.163  0.030529 *  
#> ca4          1.51991    1.97982   0.768  0.442666    
#> thal1        2.18485    3.37490   0.647  0.517383    
#> thal2        2.50663    3.28511   0.763  0.445447    
#> thal3        0.72976    3.28462   0.222  0.824179    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 333.83  on 241  degrees of freedom
#> Residual deviance: 135.95  on 224  degrees of freedom
#> AIC: 171.95
#> 
#> Number of Fisher Scoring iterations: 6

Dapat dilihat sekarang variable prediktor kita sudah signifikan, walaupun Residual Deviance nya agak sedikit besar dari model sebelumnya. Dari hasil summary model kita di atas, dapat di intrepertasikan juga untuk nilai Prediktor nya dengan merubah nya ke dalam ods dan probabilitas. Misal nya Sex, untuk Sex1 (Male) akan 0.15 Kali lebih mungkin untuk tidak terkena penyakit jantung atau dengan kata lain hanya 13% untuk berpeluang terkena penyakit jantung dari pada Sex0 (Female) dengan nilai variable sama / konstan

Jika di lihat dari plot dan proporsi hasil prediksi kita, model kita lebih banyak memprediksi kelas Positive (1) => terkena penyakit jantung

Dari hasil Confusion Matrix diatas terhadap Model Logistic Regression kita dapat kita simpulkan

• Recall / Sensitivity => Yang benar di prediksi positif dari yang realita nya (aktual nya) positif oleh Model kita ada 85%

• Specifity => Yang benar di prediksi negatif dari yang realita nya (aktual nya) negatif oleh Model kita ada 62%

• Precission Yang benar di prediksi positif dari yang di prediksi nya positif oleh Model kita ada 85%

• Accuracy => Seberapa banyak yang benar di prediksi dari keseluruhan data (positif maupun negatif) oleh model kita ada 75%

Mari kita evaluasi Residual yang di miliki oleh Model kita

library(broom)
# meng-ekstrak informasi dari model yang kita punya menggunakan fungsi augment
model1_data <- augment(model_step) %>% 
  mutate(index = 1:n())

ggplot(model1_data, aes(index, .std.resid, color = target)) + 
  geom_point(alpha = .5) +
  geom_ref_line(h = 3)

Mari saya perjelas disini, bahwa Evaluasi Residual yang kita lakukan bukan bertujuan untuk mengasumsikan Normal Residual atau Error yang mendekati 0 seperti pada Linear Regression. Tetapi tujuan disini untuk melihat data point atau titik data yang mana yang tidak fit dengan model yang kita miliki, dengan cara melihat Standar Deviasi atau simpangan yang lebih dari pada 3. Dari hasil visualisasi di atas, dapat di simpulkan kalau titik data kita sudah cukup fit dengan model nya. Cuman ada 1 titik dari dari kelas 0 yang memiliki simpangan deviasi lebih dari 3. Disini saya menyimpulkan data tersebut bukan Outlier melainkan pola data yang baru kita temukan pada Dataset kita

Jika ingin di analisa lebih dalam Outlier nya. Kita dapat menggunakan Cook Distance yaitu perkiraan pengaruh titik data terhadap model atau dengan kata lain Cook Distance adalah ringkasan dari seberapa banyak model regresi kita berubah kita suatu observasi di hapus. Semakin besar nilai Cook Distance pada suatu observasi, maka akan semakin berpengaruh terhadap model jika observasi tersebut di hapus.

par(mfrow = c(2, 2))
plot(model_step)

Dari ke empat plot diatas, mari kita fokus pada Plot Residuals vs Leverage. Dari plot tersebut dapat kita simpulkan ada beberapa Outlier yang terdapat pada data kita yang melewati Cook Distance (garis putus-putus merah) nya, tetapi rata-rata data kita sudah berada di dalam Cook Distance. Dapat kita lihat juga walaupun terdapat beberapa Outlier tetapi ternyata Outlier tersebut tidak mempengaruhi hasil prediksi dari pada model kita jika di lihat dari garis tengah nya yang constant lurus. Berarti kita tidak perlu menghapus Outlier pada data kita.

Evaluasi Berikut nya kita akan Mengguanakan Pseudo R. Karena pada Logistic Regression kita tidak punya yang R-Square seperti pada Linear Regression. Menurut McFadden, D. (1974) “Conditional logit analysis of qualitative choice behavior.” nilai yang tergolong bagus untuk hasil perhitungan McFadden ialah 0.2 - 0.4, tetapi pada dasarnya semakin mendekati 1 artinya model kita sudah Good Fit. Ide perhitungan dari pada McFadden ialah \[ 1 - \frac{ln(LM_0)}{ln(LM_1)}\] \(ln(LM_0)\) = Kemungkinan nilai Log dari Model dengan Prediktor yang kita sertakan \(ln(LM_1)\) = Kemungkinan nilai Log dari Model tanpa Prediktor hanya intercept sebagai prediktor

pR2(model_step)["McFadden"]

#> fitting null model for pseudo-r2

#>  McFadden 
#> 0.5927473

Yeayyy, kita dapat nilai di atas 0.4 atau mendekati 1, artinya model kita sudah Good Fit

Terlihat dari summary data kita, masih terdapat range data yang berbeda. Ada baik nya kita menormalisasikan data kita agar perhitungan jarak yang di lakukan K-NN semakin baik

Normalisasikan Data dengan Z-Score, tetapi sebelum itu mari lakukan Cross Validation terlebih dahulu

set.seed(100)
index_two <- sample(nrow(heart_two), nrow(heart_two) * 0.8) 
# prediktor
heart_train <- heart_two[index_two,]
heart_test <- heart_two[-index_two,]

prop.table(table(heart_train$target))

#> 
#>         0         1 
#> 0.4586777 0.5413223

proporsi data target terlihat cukup balance

Buat variable prediktor dan target untuk data train dan test

# prediktor
heart_train_x <- heart_train %>% select(-target)

heart_test_x <- heart_test %>% select(-target)
# target
heart_train_y <- heart_train[,"target"]
heart_test_y <- heart_test[,"target"]

Sekarang barulah kita melakukan Normalisasi dengan Z-Score

# scaling data prediktor
heart_train_xs <- scale(heart_train_x)
heart_test_xs <- scale(heart_test_x, 
                      center = attr(heart_train_xs,"scaled:center"), 
                      scale = attr(heart_train_xs, "scaled:scale"))

Untuk Scaling terhadap data test kita menggunakan attribut dari data train (mean & Standar Deviasi nya) agar tidak menghasilkan perhitungan jarak yang berbeda antara data train dan test

Mari kita lihat dari hasil di Confusion Matrix di atas, kita memiliki Accuracy sebesar 77% yang artinya model kita mampu memprediski keseluruhan data baik positif maupun negatif sebesar 77%. Untuk Recall/Sensitivity atau Yang benar di prediksi positif dari yang realita nya (aktual nya) positif ialah 94% dan Precission nya atau Yang benar di prediksi positif dari yang di prediksi nya positif ada 72%

Mari kita lihat estimasi Error dari pada model K-NN kita

# error estimasi
error <- mean(heart_pred != heart_test_y)
error

#> [1] 0.2295082

Apakah Error Tersebut besar atau kecil ? Maka kita harus melihat setiap jumlah k yang di gunakan untuk melihat Error terkecil dan terbesar nya

predicted.type <- NULL
error.rate <- NULL
# lakukan loop sampe dengan k optimum yakni 21
for (i in 1:21) {
  predicted.type <- knn(heart_train_xs, heart_test_xs, heart_train_y, k=i)
  error.rate[i] <- mean(predicted.type!=heart_test_y)
}

# buat data frame dari hasil error yang sudah kita dapatkan di atas
knn.error <- as.data.frame(cbind(k=1:21,error.type =error.rate))

# visualisasikan error rate nya berdasarkan k 
ggplot(knn.error,aes(k,error.type))+ 
  geom_point()+ 
  geom_line() + 
  scale_x_continuous(breaks=1:21)+ 
  theme_bw() +
  xlab("Value of K") +
  ylab('Error')

Dapat di lihat dari line plot di atas, terdapat beberapa jumlah k yang memiliki nilai Error kecil. Tapi disini kita akan mencoba memilih jumlah k = 19 agar tidak terlalu kecil, karena jika kita memiliki jumlah data yang lumayan banyak observasi nya lalu kita memilih jumlah k yang kecil maka K-NN rentan mengklasifikasi kan data baru ke kelas Outlier

Mari latih ulang data kita dengan jumlah k = 19

heart_pred <- knn(train = heart_train_xs, test = heart_test_xs, cl = as.factor(heart_train_y), k = 19)

Liat Estimasi Error

error <- mean(heart_pred != heart_test_y)
error

#> [1] 0.2131148

Yeayy kita sudah memiliki Estimasi Error yang lebih kecil sekarang

Mari lihat Confusion Matrix nya

knn_conf <- confusionMatrix(data=heart_pred, reference=heart_test_y, positive="1")
knn_conf

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 15  1
#>          1 12 33
#>                                           
#>                Accuracy : 0.7869          
#>                  95% CI : (0.6632, 0.8814)
#>     No Information Rate : 0.5574          
#>     P-Value [Acc > NIR] : 0.0001579       
#>                                           
#>                   Kappa : 0.5492          
#>                                           
#>  Mcnemar's Test P-Value : 0.0055457       
#>                                           
#>             Sensitivity : 0.9706          
#>             Specificity : 0.5556          
#>          Pos Pred Value : 0.7333          
#>          Neg Pred Value : 0.9375          
#>              Prevalence : 0.5574          
#>          Detection Rate : 0.5410          
#>    Detection Prevalence : 0.7377          
#>       Balanced Accuracy : 0.7631          
#>                                           
#>        'Positive' Class : 1               
#> 

Lihat dari segi Akurasi dan Recall menjadi lebih tinggi :)