Heart Disease Detection
Davel Zhafran
4/10/2021
Intro
Pada LBB ini saya akan mencoba mengaplikasikan ilmu yang telah dipelajari mengenai Classification Machine Learning menggunakan Logistic Regression dan k-Nearest Neighbor. Data yang digunakan pada kesempatan kali ini adalah data pasien yang mendiagnosakan keluhannya akan penyakit jantung pada suatu ruah sakit, dan akan diprediksi bagaimana pengaruh karakteristik dan gejala yang dimilik pasien.
Preparation
Library and Setup
Dalam melakukan Analisis kita akan menggunakan package dplyr, MASS, gtools, gmodels, ggplot2, class, car, hnp dan ROCR package menggunakan library().
# input library
library(dplyr)
library(MASS)
library(gtools)
library(gmodels)
library(ggplot2)
library(class)
library(tidyr)Import Dataset
Dataset yang akan digunakan pada artikel ini adalah data mengenai pasien yang terkena penyakit jantung berdasarkan beberapa karakteristik dan gejala yang dialami pada pasien.
df <- read.csv("data_input/heart.csv")
df %>% head(5)#> ï..age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
#> 1 63 1 3 145 233 1 0 150 0 2.3 0 0 1
#> 2 37 1 2 130 250 0 1 187 0 3.5 0 0 2
#> 3 41 0 1 130 204 0 0 172 0 1.4 2 0 2
#> 4 56 1 1 120 236 0 1 178 0 0.8 2 0 2
#> 5 57 0 0 120 354 0 1 163 1 0.6 2 0 2
#> target
#> 1 1
#> 2 1
#> 3 1
#> 4 1
#> 5 1str(df)#> '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 ...Berikut adalah informasi penting dalam data :
age : dalam tahun
sex : (1 = laki-laki; 0 = perempuan)
cp : chest pain type (4 values)
trestbps : resting blood pressure (in mmHg)
chol : serum cholestoral (mg/dl)
fbs : (gula darah puasa> 120 mg / dl) (1 = benar; 0 = salah)
restecg : resting electrocardiographic results (values 0,1,2)
thalach : maximum heart rate achieved
exang : exercise induced angina (1 = ya; 0 = tidak)
oldpeak : ST depression induced by exercise relative to rest
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.
Data Pre-process
Converting Data Type
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.
df <- df %>%
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("Health", "Not Health")),
trestbps = as.integer(trestbps),
chol = as.integer(chol),
thalach = as.integer(thalach),
ï..age = as.integer(ï..age))
str(df)#> 'data.frame': 303 obs. of 14 variables:
#> $ ï..age : int 30 4 8 23 24 24 23 11 19 24 ...
#> $ sex : Factor w/ 2 levels "Female","Male": 2 2 1 2 1 2 1 2 2 2 ...
#> $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 2 2 1 1 2 2 3 3 ...
#> $ trestbps: int 32 23 23 15 15 29 29 15 44 35 ...
#> $ chol : int 65 81 36 68 146 26 117 93 32 10 ...
#> $ fbs : Factor w/ 2 levels "False","True": 2 1 1 1 1 1 1 1 2 1 ...
#> $ restecg : Factor w/ 3 levels "0","1","2": 1 2 1 2 2 2 1 2 2 2 ...
#> $ thalach : int 50 85 72 77 63 48 53 73 62 74 ...
#> $ exang : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 1 1 1 1 1 ...
#> $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
#> $ slope : Factor w/ 3 levels "0","1","2": 1 1 3 3 3 2 2 3 3 3 ...
#> $ ca : Factor w/ 5 levels "0","1","2","3",..: 1 1 1 1 1 1 1 1 1 1 ...
#> $ thal : Factor w/ 4 levels "0","1","2","3": 2 3 3 3 3 2 3 4 4 3 ...
#> $ target : Factor w/ 2 levels "Health","Not Health": 2 2 2 2 2 2 2 2 2 2 ...sex + cp + fbs + restecg + exang + slope + ca + thal
Missing Values
Selanjutnya yaitu melakukan pengecekan terhadap missing value. Missing value perlu kita cek terlebih dahulu agar tidak mengganggu dalam melakukan pemodelan nantinya.
colSums(is.na(df))#> ï..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 0Data Proportion
Sebelum melakukan pemodelan, kita perlu melihat terlebih dahulu proporsi dari target variabel yang kita miliki pada kolom target.
table(df$target)#>
#> Health Not Health
#> 138 165prop.table(table(df$target))#>
#> Health Not Health
#> 0.4554455 0.5445545Data Exploration
Sebelum memulai pembuatan model preidksi kita akan terlebih dahulu melakukan data eksplorasi terhadap variabel yang ada dan bagaimana hubungannya dengan variabel-variabel laninnya.
ggplot(df,mapping = aes(ï..age))+
geom_histogram(fill="blue",col="black",bins = 20)
ggplot(df,mapping = aes(ï..age,fill=target))+
geom_density(alpha=0.1)
ggplot(df,mapping = aes(target,ï..age))+geom_boxplot(fill="blue",col="black")
ggplot(df,mapping = aes(sex,fill=target))+
geom_bar(col="black")+
geom_text(stat="count",aes(label=..count..),
position=position_stack(0.5), color="white", size=4) 
# Logistic Regression
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.
Cross Validation
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.
set.seed(305)
# Set splitting ratio
intrain <- sample(nrow(df), nrow(df)*0.8)
# make train and test data
df_train <- df[intrain,]
df_test <- df[-intrain,]
# check proportion
prop.table(table(df_train$target))#>
#> Health Not Health
#> 0.4545455 0.5454545prop.table(table(df_test$target))#>
#> Health Not Health
#> 0.4590164 0.5409836Model Creation
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.
Model 1
Model yang pertama yang akan kita lakukan adalah menggunakan seluruh variabel prediktor yang baik yang berkelas integer dan factor, lalu kita akan melakukan stepwise method untuk menentukan kombinasi terbaik dari variabel prediktor yang ada.
# stepwise: automatic model selection method
options(warn=-1)
log_model_all <- glm(target ~ ., family="binomial", data= df_train)
log_model_nothing <- glm(target ~ 1, family="binomial", data= df_train)
log_model1 <- step(log_model_nothing,
list(lower=formula(log_model_nothing),
upper=formula(log_model_all)),
direction="both", trace = F, test= "F")
formula(log_model1)#> target ~ ca + thal + exang + slope + cp + sex + trestbps + thalachlog_model1 <- glm(target ~ thal + ca + cp + oldpeak + slope + sex + trestbps + exang,
family = "binomial", data = df_train)
summary(log_model1)#>
#> Call:
#> glm(formula = target ~ thal + ca + cp + oldpeak + slope + sex +
#> trestbps + exang, family = "binomial", data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -3.0185 -0.3177 0.1067 0.4742 2.0377
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 1.16958 3.81362 0.307 0.759083
#> thal1 2.83789 3.76423 0.754 0.450904
#> thal2 2.35188 3.66442 0.642 0.520992
#> thal3 0.80029 3.66762 0.218 0.827270
#> ca1 -2.80714 0.57687 -4.866 0.00000114 ***
#> ca2 -3.27655 0.86982 -3.767 0.000165 ***
#> ca3 -1.92626 0.96901 -1.988 0.046827 *
#> ca4 15.60129 1128.58235 0.014 0.988971
#> cp1 0.64044 0.61389 1.043 0.296833
#> cp2 1.93244 0.57406 3.366 0.000762 ***
#> cp3 2.08722 0.74577 2.799 0.005130 **
#> oldpeak -0.27651 0.25679 -1.077 0.281564
#> slope1 -0.66815 0.89162 -0.749 0.453639
#> slope2 0.97571 0.97868 0.997 0.318783
#> sexMale -1.54848 0.57453 -2.695 0.007034 **
#> trestbps -0.04200 0.02078 -2.021 0.043234 *
#> exangYes -0.99024 0.49254 -2.010 0.044382 *
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 151.14 on 225 degrees of freedom
#> AIC: 185.14
#>
#> Number of Fisher Scoring iterations: 15Dari variabel-variabel di atas terdapat beberapa variabel yang terpilih seperti, thal, ca, oldpeak, slope, sex, trestbps dan exang. Akan tetapi variabel thal disini memiliki signifikansi yang rendah dengan model akhir karena p-value > 0.05. Variabel tersebut adalah thal, slope dan oldpeak untuk itu kita akan melakukan update pada logistic model yang sudah kitabangung tadi. pertama-tama kita akan menghilangkan thal dan slope karena p-value nya cukup besar.
log_model1 <- update(log_model1, .~.-thal-slope)
summary(log_model1)#>
#> Call:
#> glm(formula = target ~ ca + cp + oldpeak + sex + trestbps + exang,
#> family = "binomial", data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.5789 -0.4158 0.1874 0.5817 1.9945
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 3.30598 0.70354 4.699 0.000002614 ***
#> ca1 -2.52959 0.50450 -5.014 0.000000533 ***
#> ca2 -2.47700 0.71651 -3.457 0.000546 ***
#> ca3 -2.30365 0.80186 -2.873 0.004068 **
#> ca4 14.33996 1374.33998 0.010 0.991675
#> cp1 0.98171 0.57740 1.700 0.089091 .
#> cp2 1.75835 0.49271 3.569 0.000359 ***
#> cp3 1.81494 0.71074 2.554 0.010662 *
#> oldpeak -0.63533 0.21440 -2.963 0.003044 **
#> sexMale -1.45441 0.45809 -3.175 0.001499 **
#> trestbps -0.04014 0.01934 -2.075 0.037951 *
#> exangYes -1.32679 0.44762 -2.964 0.003036 **
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 177.80 on 230 degrees of freedom
#> AIC: 201.8
#>
#> Number of Fisher Scoring iterations: 15Lalu setelah dilakukan pengurangan variabel, masih di dapat satu kelemahan. Apabila kita melihat variabel ca, khususnya pada coefficient (Estimate) ca4 nilainya terlihat cukup tinggi, sebesar 14.33. Hal ini berarti variabel ca memiliki perfect seperation dibandingkan variabel-variabel lainnya sehingga harus dihilangkan.
log_model1 <- update(log_model1, .~.-ca)
summary(log_model1)#>
#> Call:
#> glm(formula = target ~ cp + oldpeak + sex + trestbps + exang,
#> family = "binomial", data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.3369 -0.6535 0.3052 0.6989 2.3077
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 2.26393 0.57440 3.941 0.0000810 ***
#> cp1 1.22843 0.49705 2.471 0.013457 *
#> cp2 1.71638 0.42615 4.028 0.0000563 ***
#> cp3 1.98298 0.61992 3.199 0.001380 **
#> oldpeak -0.73694 0.18899 -3.899 0.0000964 ***
#> sexMale -1.45021 0.40903 -3.545 0.000392 ***
#> trestbps -0.03605 0.01681 -2.144 0.032006 *
#> exangYes -1.01315 0.38349 -2.642 0.008244 **
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 221.79 on 234 degrees of freedom
#> AIC: 237.79
#>
#> Number of Fisher Scoring iterations: 5Model 2
Lalu pada model kedua kita akan menggunakaan seluruh data yang kelasnya berupa factor, bukan berupa angka.
log_model2 <- glm(formula = target ~ sex + cp + fbs + restecg + exang + slope + ca + thal, family = "binomial",
data = df_train)
summary(log_model2)#>
#> Call:
#> glm(formula = target ~ sex + cp + fbs + restecg + exang + slope +
#> ca + thal, family = "binomial", data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.7982 -0.3963 0.1047 0.4464 2.0133
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -0.6577 3.0213 -0.218 0.82767
#> sexMale -1.4504 0.5505 -2.635 0.00842 **
#> cp1 0.5992 0.6047 0.991 0.32177
#> cp2 1.6852 0.5688 2.963 0.00305 **
#> cp3 1.5747 0.6839 2.303 0.02130 *
#> fbsTrue 0.6277 0.6784 0.925 0.35482
#> restecg1 0.1735 0.4200 0.413 0.67951
#> restecg2 -12.7005 2399.5449 -0.005 0.99578
#> exangYes -1.1600 0.4794 -2.420 0.01554 *
#> slope1 -0.1952 0.7900 -0.247 0.80486
#> slope2 1.6346 0.8260 1.979 0.04783 *
#> ca1 -2.7060 0.5719 -4.732 0.00000223 ***
#> ca2 -3.5629 0.8492 -4.196 0.00002719 ***
#> ca3 -2.2942 0.9183 -2.498 0.01247 *
#> ca4 15.7051 1100.7298 0.014 0.98862
#> thal1 2.7581 3.0332 0.909 0.36318
#> thal2 2.5097 2.9092 0.863 0.38832
#> thal3 0.8534 2.9116 0.293 0.76946
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 155.77 on 224 degrees of freedom
#> AIC: 191.77
#>
#> Number of Fisher Scoring iterations: 15Model 3
Lalu terakhir kita akan menggunakan kembali seluruh variabel prediktor yang nantinya akan dilakukan permodelan menggunakan metode stepwise AIC.
log_model3 <- glm(formula = target ~ ., family = "binomial", data = df)
summary(log_model3)#>
#> Call:
#> glm(formula = target ~ ., family = "binomial", data = df)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.93463 -0.29293 0.09985 0.44414 3.13409
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 0.021664 2.860737 0.008 0.993958
#> ï..age 0.024829 0.025584 0.970 0.331800
#> sexMale -1.874839 0.566254 -3.311 0.000930 ***
#> cp1 0.900374 0.575068 1.566 0.117423
#> cp2 2.013060 0.531039 3.791 0.000150 ***
#> cp3 2.392627 0.713671 3.353 0.000801 ***
#> trestbps -0.040118 0.019732 -2.033 0.042037 *
#> chol -0.007377 0.005932 -1.244 0.213661
#> fbsTrue 0.468909 0.590404 0.794 0.427070
#> restecg1 0.438692 0.397785 1.103 0.270098
#> restecg2 -0.753508 2.716368 -0.277 0.781477
#> thalach 0.019987 0.012935 1.545 0.122292
#> exangYes -0.749745 0.453281 -1.654 0.098120 .
#> oldpeak -0.402452 0.240916 -1.671 0.094820 .
#> slope1 -0.764949 0.872968 -0.876 0.380887
#> slope2 0.705212 0.942602 0.748 0.454367
#> ca1 -2.308089 0.524018 -4.405 0.0000106 ***
#> ca2 -3.413837 0.810550 -4.212 0.0000253 ***
#> ca3 -2.190578 0.944735 -2.319 0.020410 *
#> ca4 1.272067 1.726047 0.737 0.461133
#> thal1 2.684842 2.686716 0.999 0.317648
#> thal2 2.468552 2.602963 0.948 0.342945
#> thal3 0.992801 2.605502 0.381 0.703173
#> ---
#> 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: 179.81 on 280 degrees of freedom
#> AIC: 225.81
#>
#> Number of Fisher Scoring iterations: 6Model 2 using Stepwise Method
Dari model 2 tadi akan kita lakukan metode stepwise untuk mendapatkan kombinasi variabel prediktor terbaik.
log_back_model2 <- stepAIC(log_model2, direction = "backward", trace = F)
summary(log_back_model2)#>
#> Call:
#> glm(formula = target ~ sex + cp + exang + slope + ca + thal,
#> family = "binomial", data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.81901 -0.39990 0.09717 0.43488 1.96676
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -0.3129 3.5791 -0.087 0.93032
#> sexMale -1.3989 0.5447 -2.568 0.01023 *
#> cp1 0.6548 0.5989 1.093 0.27428
#> cp2 1.8087 0.5568 3.248 0.00116 **
#> cp3 1.6068 0.6800 2.363 0.01812 *
#> exangYes -1.1246 0.4777 -2.354 0.01857 *
#> slope1 -0.2553 0.7720 -0.331 0.74086
#> slope2 1.5960 0.8081 1.975 0.04826 *
#> ca1 -2.7408 0.5672 -4.833 0.00000135 ***
#> ca2 -3.4441 0.8191 -4.205 0.00002612 ***
#> ca3 -2.2252 0.9036 -2.463 0.01379 *
#> ca4 15.7215 1094.4872 0.014 0.98854
#> thal1 2.5721 3.6007 0.714 0.47501
#> thal2 2.2616 3.4950 0.647 0.51757
#> thal3 0.6058 3.4967 0.173 0.86247
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 156.85 on 227 degrees of freedom
#> AIC: 186.85
#>
#> Number of Fisher Scoring iterations: 15Lalu setelah dilakukan stepwise, kita akan mengeliminasi variabel prediktor mana yang pengaruhnya tidak signifikan terhadap variabel target.
log_back_model2 <- update(log_back_model2, .~.-thal)
summary(log_back_model2)#>
#> Call:
#> glm(formula = target ~ sex + cp + exang + slope + ca, family = "binomial",
#> data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.5513 -0.5366 0.1163 0.5012 2.0377
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 1.3885 0.8268 1.679 0.093080 .
#> sexMale -1.8093 0.4761 -3.800 0.000145 ***
#> cp1 0.8846 0.5788 1.528 0.126425
#> cp2 1.7770 0.5049 3.520 0.000432 ***
#> cp3 1.5662 0.6723 2.330 0.019829 *
#> exangYes -1.2552 0.4497 -2.791 0.005247 **
#> slope1 -0.1020 0.7309 -0.140 0.889030
#> slope2 1.8267 0.7559 2.417 0.015661 *
#> ca1 -2.6668 0.5353 -4.982 0.000000631 ***
#> ca2 -3.2285 0.7528 -4.289 0.000017968 ***
#> ca3 -2.6171 0.8037 -3.256 0.001129 **
#> ca4 14.9777 1228.4630 0.012 0.990272
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 173.11 on 230 degrees of freedom
#> AIC: 197.11
#>
#> Number of Fisher Scoring iterations: 15Lalu setelah dilakukan pengurangan variabel thal, masih di dapat satu kelemahan. Apabila kita melihat variabel ca, khususnya pada coefficient (Estimate) ca4 nilainya terlihat cukup tinggi, sebesar 14.33. Hal ini berarti variabel ca memiliki perfect seperation dibandingkan variabel-variabel lainnya sehingga harus dihilangkan.
log_back_model2 <- update(log_back_model2, .~.-ca)
summary(log_back_model2)#>
#> Call:
#> glm(formula = target ~ sex + cp + exang + slope, family = "binomial",
#> data = df_train)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.5266 -0.8381 0.2508 0.6293 2.2467
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 0.2065 0.6864 0.301 0.76348
#> sexMale -1.6311 0.4097 -3.981 0.0000687 ***
#> cp1 1.4367 0.4923 2.919 0.00352 **
#> cp2 1.7304 0.4219 4.101 0.0000411 ***
#> cp3 1.7307 0.5942 2.913 0.00358 **
#> exangYes -0.9032 0.3811 -2.370 0.01780 *
#> slope1 -0.1126 0.6435 -0.175 0.86114
#> slope2 1.5067 0.6666 2.260 0.02380 *
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 333.48 on 241 degrees of freedom
#> Residual deviance: 227.76 on 234 degrees of freedom
#> AIC: 243.76
#>
#> Number of Fisher Scoring iterations: 5Model 3 using Stepwise Method
Sama seperti sebelumnya kita akan melakukan stepwise method untuk mendapatkan kombinasi variabel prediktor terbaik. Lalu setaelah dilakukan stepwise akan dieliminasi variabel prediktor yang tidak berpengaruh secara signifikan.
log_back_model3 <- stepAIC(log_model3, direction = "backward", trace = F)
summary(log_back_model3)#>
#> Call:
#> glm(formula = target ~ sex + cp + trestbps + exang + oldpeak +
#> slope + ca + thal, family = "binomial", data = df)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -3.0328 -0.3249 0.1078 0.4533 2.9938
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 1.19413 4.13405 0.289 0.77269
#> sexMale -1.63074 0.52742 -3.092 0.00199 **
#> cp1 1.02965 0.56255 1.830 0.06720 .
#> cp2 2.23219 0.51806 4.309 0.00001642 ***
#> cp3 2.53799 0.69858 3.633 0.00028 ***
#> trestbps -0.03543 0.01807 -1.960 0.04996 *
#> exangYes -0.85028 0.43616 -1.949 0.05124 .
#> oldpeak -0.48143 0.23077 -2.086 0.03697 *
#> slope1 -0.88890 0.82488 -1.078 0.28121
#> slope2 0.71902 0.89578 0.803 0.42216
#> ca1 -2.35109 0.49735 -4.727 0.00000228 ***
#> ca2 -3.09199 0.75146 -4.115 0.00003878 ***
#> ca3 -2.25640 0.90174 -2.502 0.01234 *
#> ca4 1.26420 1.62469 0.778 0.43650
#> thal1 2.62232 4.08741 0.642 0.52116
#> thal2 2.35771 4.02260 0.586 0.55780
#> thal3 0.89714 4.02488 0.223 0.82362
#> ---
#> 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: 186.10 on 286 degrees of freedom
#> AIC: 220.1
#>
#> Number of Fisher Scoring iterations: 6log_back_model3 <- update(log_back_model3, .~.-thal-slope)
summary(log_back_model3)#>
#> Call:
#> glm(formula = target ~ sex + cp + trestbps + exang + oldpeak +
#> ca, family = "binomial", data = df)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.6059 -0.4277 0.1627 0.5132 2.3455
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 3.09781 0.64253 4.821 0.00000143 ***
#> sexMale -1.62412 0.41805 -3.885 0.000102 ***
#> cp1 1.41749 0.52114 2.720 0.006528 **
#> cp2 2.15065 0.45642 4.712 0.00000245 ***
#> cp3 2.36054 0.65695 3.593 0.000327 ***
#> trestbps -0.03287 0.01713 -1.918 0.055064 .
#> exangYes -1.17690 0.39944 -2.946 0.003216 **
#> oldpeak -0.76009 0.19322 -3.934 0.00008358 ***
#> ca1 -2.13910 0.44372 -4.821 0.00000143 ***
#> ca2 -2.33841 0.61018 -3.832 0.000127 ***
#> ca3 -2.38243 0.77088 -3.091 0.001998 **
#> ca4 -0.09606 1.40540 -0.068 0.945505
#> ---
#> 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: 215.98 on 291 degrees of freedom
#> AIC: 239.98
#>
#> Number of Fisher Scoring iterations: 6Dari ketiga model di atas, kita akan mulai mengeliminasi model-model mana yang relatif kurang baik dibandingkan model lainnya. Pertama akan kita ambil nilai AIC yang terburuk.
log_model1$aic#> [1] 237.7929log_back_model2$aic#> [1] 243.7614log_back_model3$aic#> [1] 239.9823Didapatkan AIC terburuk adalah pada model 3. Setelah melngecek nilai AIC, perlu juga kita memverifikasi fit dari model terhadap deviance dari statistik. Null Hypothesis disini adalah model deviasi nya tidak terdistribusi normal.
pchisq(log_model1$deviance, df = log_model1$df.residual, lower.tail = T)#> [1] 0.2934151pchisq(log_back_model2$deviance, df = log_model1$df.residual, lower.tail = T)#> [1] 0.3973975pchisq(log_back_model3$deviance, df = log_model1$df.residual, lower.tail = T)#> [1] 0.2049028Dari data tersebut didapat model 3 datanya tidak terdistribusi nomal alias > 0.05 untuk itu dengan menimbang nilai AIC yang juga relatif besar, maka model 3 akan kita buang.
Setelah melakukan uji deviasi kita akan lakukan pengujian multi-colinearity untuk melihat apakah antar variabel prediktor meiliki hubungan yang kuat.
library(car)
vif(log_model1)#> GVIF Df GVIF^(1/(2*Df))
#> cp 1.327403 3 1.048336
#> oldpeak 1.134499 1 1.065129
#> sex 1.072831 1 1.035776
#> trestbps 1.062405 1 1.030730
#> exang 1.101132 1 1.049348Tidak ada multicolienarity pada model 1 karena tidak meenuhi nilai GVIF^(1/(2*Df)).
vif(log_back_model2)#> GVIF Df GVIF^(1/(2*Df))
#> sex 1.150666 1 1.072691
#> cp 1.257791 3 1.038966
#> exang 1.127409 1 1.061795
#> slope 1.162669 2 1.038398Tidak ada multicolienarity pada Model 2 karena tidak meenuhi nilai GVIF^(1/(2*Df)).
vif(log_back_model3)#> GVIF Df GVIF^(1/(2*Df))
#> sex 1.129878 1 1.062957
#> cp 1.539215 3 1.074525
#> trestbps 1.086042 1 1.042133
#> exang 1.135197 1 1.065456
#> oldpeak 1.212696 1 1.101225
#> ca 1.291026 4 1.032445Seperti dalam model regresi linier, analisis residual dalam model regresi logistik sangat penting untuk memverifikasi apakah praanggapan tentang model tersebut terpenuhi. Untuk ini, envelope simulasi digunakan. Pada dasarnya, jika modelnya memadai, sebagian besar titik akan berada di dalam envelope, seperti yang terjadi pada model 1 yang dikembangkan, di mana hanya 0,83% titik yang tertinggal di luar envelope
library(hnp)
set.seed(305)
hnp(log_model1, halfnormal = F, paint.out = T, pch = 16, sim = 500, print.on = T)#> Binomial model
Sama seperi model 1, model 2 juga hanya memiliki 0,83% dari datanya berada di luar envelope.
hnp(log_back_model2, halfnormal = F, paint.out = T, pch = 16, sim = 500, print.on = T)#> Binomial model
Prediction
Setelah itu akan kita lakukan prediksi untuk melihat bagaimana fit model yang telah kita bangun terhadap data-data baru. Pertama kita akan melakukan prediksi tersebut menggunakan model 1 kepada data test. lalu data hasil akan berupa tipe “response” dimana adalah berupa angka 0-1 yang merupakan probabilitas apakah prediksi mendekati
df_test$prob1 <- predict(object = log_model1, type = "response", newdata = df_test)
df_test$pred.label1 <- ifelse(test = df_test$prob1 > 0.5, yes = "Not Health", no = "Health")
df_test$target_type <- ifelse(test = df_test$target == "Not Health", 1, 0)Untuk mengevaluasi kualitas model dalam mengklasifikasikan pasien menderita penyakit jantung atau tidak, kami menggunakan kurva ROC. Model yang dikembangkan menyajikan area di bawah kurva 0,90, nilai ini tidak diragukan lagi sangat baik.
library(ROCR)
pred_model1 <- prediction(df_test$prob1, df_test$target_type)
perf <- performance(pred_model1,"tpr", "fpr")
plot(perf, colorize = TRUE, main="ROC Curve")
abline(0, 1, lty = 2)
performance(pred_model1,"auc")@y.values[[1]] # area below the curve#> [1] 0.9480519df_test$prob2 <- predict(object = log_back_model2, type = "response", newdata = df_test)
df_test$pred.label2 <- ifelse(test = df_test$prob2 > 0.5, yes = "Not Health", no = "Health")Sama seperti model 1, Model 2 yang telah dikembangkan menyajikan area di bawah kurva sebesar 0,90, nilai ini tidak diragukan lagi sangat baik.
pred_model2 <- prediction(df_test$prob2, df_test$target_type)
perf <- performance(pred_model2,"tpr", "fpr")
plot(perf, colorize = TRUE, main="ROC Curve")
abline(0, 1, lty = 2)
performance(pred_model1,"auc")@y.values[[1]] # area below the curve#> [1] 0.9480519library(ggplot2)
ggplot(df_test, aes(x = prob1)) +
geom_density(lwd = 0.5) +
theme_minimal()
Pada grafik diatas, dapat diinterpretasikan bahwa hasil prediksi yang dilakukan lecondongan sama di kedua variabel target yang artinya Not Health dan Health hampir seimbang.
ggplot(df_test, aes(x = prob2)) +
geom_density(lwd = 0.5) +
theme_minimal()
Pada grafik diatas, dapat diinterpretasikan bahwa hasil prediksi yang dilakukan sedikit condong ke arah 1 yang artinya Not Health. Lalu berikut adalah hasil prediksi yang telah di bangun.
library(dplyr)
df_test[,c("pred.label1", "target", "pred.label2")] %>% sample()#> target pred.label2 pred.label1
#> 2 Not Health Not Health Health
#> 3 Not Health Not Health Not Health
#> 4 Not Health Not Health Not Health
#> 9 Not Health Not Health Not Health
#> 18 Not Health Not Health Not Health
#> 19 Not Health Not Health Health
#> 20 Not Health Not Health Not Health
#> 26 Not Health Not Health Not Health
#> 44 Not Health Not Health Not Health
#> 45 Not Health Not Health Not Health
#> 64 Not Health Health Not Health
#> 65 Not Health Not Health Not Health
#> 72 Not Health Not Health Not Health
#> 83 Not Health Not Health Not Health
#> 94 Not Health Not Health Not Health
#> 99 Not Health Not Health Not Health
#> 103 Not Health Not Health Not Health
#> 105 Not Health Not Health Not Health
#> 107 Not Health Not Health Not Health
#> 109 Not Health Not Health Not Health
#> 111 Not Health Not Health Health
#> 112 Not Health Not Health Not Health
#> 116 Not Health Not Health Not Health
#> 124 Not Health Not Health Not Health
#> 126 Not Health Not Health Not Health
#> 136 Not Health Not Health Not Health
#> 140 Not Health Health Health
#> 143 Not Health Not Health Not Health
#> 145 Not Health Not Health Not Health
#> 147 Not Health Not Health Not Health
#> 155 Not Health Not Health Not Health
#> 161 Not Health Not Health Not Health
#> 165 Not Health Not Health Not Health
#> 175 Health Health Health
#> 187 Health Health Health
#> 193 Health Health Health
#> 195 Health Not Health Health
#> 200 Health Not Health Not Health
#> 203 Health Health Health
#> 206 Health Health Health
#> 213 Health Health Health
#> 216 Health Health Health
#> 219 Health Health Health
#> 234 Health Health Health
#> 237 Health Not Health Not Health
#> 239 Health Health Health
#> 246 Health Health Health
#> 247 Health Health Health
#> 252 Health Health Health
#> 253 Health Not Health Health
#> 261 Health Health Health
#> 264 Health Health Health
#> 266 Health Health Health
#> 267 Health Health Health
#> 270 Health Health Health
#> 280 Health Health Health
#> 283 Health Not Health Not Health
#> 284 Health Not Health Health
#> 292 Health Health Health
#> 293 Health Health Health
#> 298 Health Health HealthUntuk mengevaluasi model yang telah kita buat, kita akan menggunakan confusion matrix.
library(caret)
model_eval1 <- confusionMatrix(as.factor(df_test$pred.label1), as.factor(df_test$target), positive = "Not Health")
model_eval1#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Health Not Health
#> Health 25 4
#> Not Health 3 29
#>
#> Accuracy : 0.8852
#> 95% CI : (0.7778, 0.9526)
#> No Information Rate : 0.541
#> P-Value [Acc > NIR] : 0.000000008572
#>
#> Kappa : 0.7696
#>
#> Mcnemar's Test P-Value : 1
#>
#> Sensitivity : 0.8788
#> Specificity : 0.8929
#> Pos Pred Value : 0.9062
#> Neg Pred Value : 0.8621
#> Prevalence : 0.5410
#> Detection Rate : 0.4754
#> Detection Prevalence : 0.5246
#> Balanced Accuracy : 0.8858
#>
#> 'Positive' Class : Not Health
#> model_eval2 <- confusionMatrix(as.factor(df_test$pred.label2), as.factor(df_test$target), positive = "Not Health")
model_eval2#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction Health Not Health
#> Health 22 2
#> Not Health 6 31
#>
#> Accuracy : 0.8689
#> 95% CI : (0.7578, 0.9416)
#> No Information Rate : 0.541
#> P-Value [Acc > NIR] : 0.00000005049
#>
#> Kappa : 0.733
#>
#> Mcnemar's Test P-Value : 0.2888
#>
#> Sensitivity : 0.9394
#> Specificity : 0.7857
#> Pos Pred Value : 0.8378
#> Neg Pred Value : 0.9167
#> Prevalence : 0.5410
#> Detection Rate : 0.5082
#> Detection Prevalence : 0.6066
#> Balanced Accuracy : 0.8626
#>
#> 'Positive' Class : Not Health
#> model_eval2$byClass#> Sensitivity Specificity Pos Pred Value
#> 0.9393939 0.7857143 0.8378378
#> Neg Pred Value Precision Recall
#> 0.9166667 0.8378378 0.9393939
#> F1 Prevalence Detection Rate
#> 0.8857143 0.5409836 0.5081967
#> Detection Prevalence Balanced Accuracy
#> 0.6065574 0.8625541Recall <- 87.88
Specificity <- 89.285
precision <- 90.625
Accuracy <- 88.52
performance1 <- cbind.data.frame(Accuracy, Recall, precision, Specificity)
performance1#> Accuracy Recall precision Specificity
#> 1 88.52 87.88 90.625 89.285Recall <- 93.94
Specificity <- 78.57
precision <- 83.78
Accuracy <- 86.9
performance2 <- cbind.data.frame(Accuracy, Recall, precision, Specificity)
performance2#> Accuracy Recall precision Specificity
#> 1 86.9 93.94 83.78 78.57Dari confusion matrix di atas, model 1 dapat menebak lebih baik apakah pasien health dan not health karena nilainya adalah sebesar 88.52%. Dari pasien yang not health, model 2 juga lebih baik karena dapat menebak dengan sebesar 93.94% dari data aktual. Dari pasien yang health, kedua model 1 mampu menebak dengan benar pada 90,625% dari data aktual. Dari keseluruhan hasil prediksi positif yang bisa ditebak oleh model, model 1 mampu menebak dengan benar kelas positif sebesat 89,285%
Model Tuning
performa <- function(cutoff, prob, ref, postarget, negtarget)
{
predict <- factor(ifelse(prob >= cutoff, postarget, negtarget))
conf <- caret::confusionMatrix(predict , ref, positive = postarget)
acc <- conf$overall[1]
rec <- conf$byClass[1]
prec <- conf$byClass[3]
spec <- conf$byClass[2]
mat <- t(as.matrix(c(rec , acc , prec, spec)))
colnames(mat) <- c("recall", "accuracy", "precicion", "specificity")
return(mat)
}
co <- seq(0.01,0.80,length=100)
result <- matrix(0,100,4)
for(i in 1:100){
result[i,] = performa(cutoff = co[i],
prob = df_test$prob1,
ref = df_test$target,
postarget = "Not Health",
negtarget = "Health")
}
data_frame("Recall" = result[,1],
"Accuracy" = result[,2],
"Precision" = result[,3],
"Specificity" = result[,4],
"Cutoff" = co) %>%
gather(key = "performa", value = "value", 1:4) %>%
ggplot(aes(x = Cutoff, y = value, col = performa)) +
geom_line(lwd = 1.5) +
scale_color_manual(values = c("darkred","darkgreen","orange", "blue")) +
scale_y_continuous(breaks = seq(0,1,0.1), limits = c(0,1)) +
scale_x_continuous(breaks = seq(0,1,0.1)) +
labs(title = "Tradeoff model perfomance") +
theme_minimal() +
theme(legend.position = "top",
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank())
Berdasarkan Tradeoff model performance diatas, dapat kita tahu bahwa dengan cutoff 0.5 kita memperoleh nilai precision dan Specificity yang agak tinggi, namun nilai Accuracy dan nilai Recall agak rendah.
Model Interpretation
options(scipen = 999)
exp(log_model1$coefficients) %>% data.frame()#> .
#> (Intercept) 9.6208554
#> cp1 3.4158464
#> cp2 5.5643402
#> cp3 7.2643752
#> oldpeak 0.4785763
#> sexMale 0.2345209
#> trestbps 0.9645934
#> exangYes 0.3630730Dari prediksi kita dapat menginterpretasi hasil sebagai berikut:
Laki-laki 23.45% lebih mungkin untuk Health dibandingkan dengan perempuan.
Tipe Chest pain dengan level 2 akan meningkatkan kemungkinan untuk terkena penyakit sebesar 3.4 kali sedangka tipe chest pain 3 dapat meningkatkan kemungkinan sebesar 5.5 kali dan tipe chest pain dengan level 4 dapat meningkatkaan kemungkinan hingga 7.3 kali
Setiap satu kenaikan nilai resting bps pada jantung maka akan sedikit menurunkan resiko penyakit jantung
K-Nearest Neighbour
Create Dummy Data
Membuat variabel dummy dari data-data kategori yang akan digunakan dalam klasifikasi. Hal ini ditujukan untuk
dummy <- dummyVars("~target+sex+cp+fbs+exang+oldpeak+slope+ca+thal", data = df)
dummy <- data.frame(predict(dummy, newdata = df))
str(dummy)#> 'data.frame': 303 obs. of 25 variables:
#> $ target.Health : num 0 0 0 0 0 0 0 0 0 0 ...
#> $ target.Not.Health: 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.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 ...dummy$target.Health <- NULL
dummy$sex.Female <- NULL
dummy$fbs.False <- NULL
dummy$exang.No <- NULLdummy %>% head()#> target.Not.Health sex.Male cp.0 cp.1 cp.2 cp.3 fbs.True exang.Yes oldpeak
#> 1 1 1 0 0 0 1 1 0 2.3
#> 2 1 1 0 0 1 0 0 0 3.5
#> 3 1 0 0 1 0 0 0 0 1.4
#> 4 1 1 0 1 0 0 0 0 0.8
#> 5 1 0 1 0 0 0 0 1 0.6
#> 6 1 1 1 0 0 0 0 0 0.4
#> slope.0 slope.1 slope.2 ca.0 ca.1 ca.2 ca.3 ca.4 thal.0 thal.1 thal.2 thal.3
#> 1 1 0 0 1 0 0 0 0 0 1 0 0
#> 2 1 0 0 1 0 0 0 0 0 0 1 0
#> 3 0 0 1 1 0 0 0 0 0 0 1 0
#> 4 0 0 1 1 0 0 0 0 0 0 1 0
#> 5 0 0 1 1 0 0 0 0 0 0 1 0
#> 6 0 1 0 1 0 0 0 0 0 1 0 0dummy %>% length()#> [1] 21Cross-Validation
dummy_train <- dummy[intrain, 2:21]
dummy_test <- dummy[-intrain, 2:21]
dummy_train_label <- dummy[intrain, 1]
dummy_test_label <- dummy[-intrain,1]knn_pred <- knn(train = dummy_train,
test = dummy_test,
cl = dummy_train_label,
k = 18)knn_conf <- confusionMatrix(data = as.factor(knn_pred), reference = as.factor(dummy_test_label), positive = "1")
knn_conf#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 24 2
#> 1 4 31
#>
#> Accuracy : 0.9016
#> 95% CI : (0.7981, 0.963)
#> No Information Rate : 0.541
#> P-Value [Acc > NIR] : 0.000000001252
#>
#> Kappa : 0.8009
#>
#> Mcnemar's Test P-Value : 0.6831
#>
#> Sensitivity : 0.9394
#> Specificity : 0.8571
#> Pos Pred Value : 0.8857
#> Neg Pred Value : 0.9231
#> Prevalence : 0.5410
#> Detection Rate : 0.5082
#> Detection Prevalence : 0.5738
#> Balanced Accuracy : 0.8983
#>
#> 'Positive' Class : 1
#> Model Evaluation
Recall <- round((31)/(31+2), 3)
Specificity <- round((23)/(23+5), 3)
precision <- round((31)/(31+5), 3)
Accuracy <- round((31+23)/ (31+23+2+5), 3)
performance3 <- cbind.data.frame(Accuracy, Recall, precision, Specificity)
performance3#> Accuracy Recall precision Specificity
#> 1 0.885 0.939 0.861 0.821Dari confusion matrix di atas, dapat diketahui bahwa model dapat menebak target dengan benar adalah sebesar 88,5%. Lalu dari pasien yang memiliki status Not Health, model dapat menebak dengan benar sebesar 94%
Dari pasien yang not health, model dapat menebak dengan sebesar 87,5% dari data aktual. Dari pasien yang health, model mampu menebak dengan benar pada 88% dari data aktual. Dari keseluruhan hasil prediksi yang bisa ditebak oleh model , model mampu menebak dengan benar kelas positif sebesat 85,7%
performance1#> Accuracy Recall precision Specificity
#> 1 88.52 87.88 90.625 89.285performance2#> Accuracy Recall precision Specificity
#> 1 86.9 93.94 83.78 78.57performance3*100#> Accuracy Recall precision Specificity
#> 1 88.5 93.9 86.1 82.1Dari ketiga model yang telah dibentuk model 1 menggunakan logistic regression menunjukkan model dengan prediksi terbaik.