Heart Attack Classification
Takdir Zulhaq Dessiaming
2022-08-29
Pada kesempatan kali ini, kita akan melakukan prediksi klasifikasi pada data serangan jantung, dengan menggunakan pendekatan Naive Bayes, Decision Tree, dan Random Forest.
Data ini diambil dari Kaggle, dan kita dapat melakukan klasifikasi pada data berikut.
About DataSet There are 13 attributes:
1. Age: Age (in years)
2. Sex: gender (1 = male; 0 = female)
3. ChestPain: Chest Pain type
– 1: typical angina (all criteria present)
– 2: atypical angina (two of three criteria satisfied)
– 3: non-anginal pain (less than one criteria satisfied)
– 4: asymptomatic (none of the criteria are satisfied)
4. Restbps: Resting Blood pressure (in mmHg, upon admission to the
hospital)
5. Chol: serum cholesterol in mg/dL
6. Fbs: fasting blood sugar > 120 mg/dL (likely to be diabetic) 1 =
true; 0 = false
7. RestECG: Resting electrocardiogram results
– Value 0: normal
– Value 1: having ST-T wave abnormality (T wave inversions and/or ST
elevation or depression of > 0.05 mV)
– Value 2: showing probable or definite left ventricular hypertrophy by
Estes’ criteria
8. MaxHR: Greatest number of beats per minute your heart can possibly
reach during all-out strenuous exercise.
9. Exang: exercise induced angina (1 = yes; 0 = no)
10. Oldpeak: ST depression induced by exercise relative to rest (in mm,
achieved by subtracting the lowest ST segment points during exercise and
rest)
11. Slope: the slope of the peak exercise ST segment, ST-T abnormalities
are considered to be a crucial indicator for identifying presence of
ischaemia
– Value 1: upsloping
– Value 2: flat
– Value 3: downsloping
12. Ca: number of major vessels (0-3) colored by fluoroscopy. Major
cardial vessels are as goes: aorta, superior vena cava, inferior vena
cava, pulmonary artery (oxygen-poor blood –> lungs), pulmonary veins
(oxygen-rich blood –> heart), and coronary arteries (supplies blood
to heart tissue).
13. AHD: 0 = normal; 1 = fixed defect (heart tissue can’t absorb
thallium both under stress and in rest); 2 = reversible defect (heart
tissue is unable to absorb thallium only under the exercise portion of
the test)
14.AHD: 0 = no disease, 1 = disease
1 Library
library(dplyr)
library(e1071)
library(caret)
library(ROCR)
library(partykit)
library(randomForest)2 Read Data
df <- read.csv("Heart Attack Data Set.csv")
df3 Data Cleaning
Mari kita lakukan pembersihan data, dengan melakukan penyesuaian tipe data, agar hasil analisis dapat berjalan dengan lancar. Dalam analisis ini pendekatan machine learning, kita akan menggunakan kolom dengan tipe data numerik dan kategorik.
df <- df %>%
# select(-Age) %>%
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)
)
str(df)## 'data.frame': 303 obs. of 14 variables:
## $ age : int 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : Factor w/ 2 levels "0","1": 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 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : int 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : Factor w/ 2 levels "0","1": 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 150 187 172 178 163 148 153 173 162 174 ...
## $ exang : Factor w/ 2 levels "0","1": 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 "0","1": 2 2 2 2 2 2 2 2 2 2 ...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 0prop.table(table(df$target))##
## 0 1
## 0.4554455 0.5445545Tipe data sudah sesuai dengan kolom yang ada, dan dilihat dari proporsi datanya, dapat dikatakan cukup seimbang.
4 Cross Validation
Mari kita coba melakukan penyeimbangan data dengan melakukan Cross Validation.
RNGkind(sample.kind = "Rounding")## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## usedset.seed(100)
# your code here
index <- sample(nrow(df), nrow(df)*0.8)
data_train <- df[index,]
data_test <- df[-index,]prop.table(table(data_train$target))##
## 0 1
## 0.4421488 0.5578512Karena tanpa melakukan Cross Validation data lebih seimbang, maka untuk analisis selanjutnya, kita akan menggunakan data awal kita. Tapi mari kita coba untuk melakukan down-sampling dan melihat proporsi datanya.
set.seed(100)
data_train_down <- downSample(x = data_train %>% select(-target), # hanya select variabel predictor
y= data_train$target, # select variabel target
yname = "target")prop.table(table(data_train_down$target))##
## 0 1
## 0.5 0.5Dengan melakukan down-sampling, data yang kita gunakan memiliki proporsi data yang seimbang, yang mana ini sangat baik dalam melakukan pemodelan, khususnya pada data training untuk dilakukan pelatihan.
5 Naive Bayes
- Naive Bayes adalah model machine learning yang memanfaatkan Bayes’ Theorem dalam melakukan klasifikasi.
- Hubungan antara prediktor dengan target variabel dianggap saling dependen.
- Dikatakan “Naive” karena tiap prediktor diasumsikan saling independent (tidak berhubungan satu sama lain) dan memiliki bobot yang sama (memiliki kepentingan atau pengaruh yang sama) dalam melakukan prediksi. Hal ini untuk memudahkan kalkulasi (rumus menjadi lebih simpel) dan mengurangi beban komputasi.
Model pertama, kita menggunakan metode Naive Bayes.
5.1 Model Fitting
model_naive <- naiveBayes(target~., data_train_down, laplace = 1)Karena sebelumnya kita telah melakukan data cleaning dan cross validation (splitting data), maka langsung saja kita langsung membuat modelnya.
5.2 Prediction
pred_naive <- predict(model_naive, data_test, type = "class")Lalu kita melakukan prediksi dengan labelnya berupa class, yaitu berupa factor/kategorik.
5.3 Model Evaluation
confusionMatrix(pred_naive, data_test$target, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 25 6
## 1 6 24
##
## Accuracy : 0.8033
## 95% CI : (0.6816, 0.894)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 1.809e-06
##
## Kappa : 0.6065
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8000
## Specificity : 0.8065
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.8065
## Prevalence : 0.4918
## Detection Rate : 0.3934
## Detection Prevalence : 0.4918
## Balanced Accuracy : 0.8032
##
## 'Positive' Class : 1
## Pada kasus ini, yang manakah error yang kita ingin minimalisir? False Negative / False Positive? - False Negative : pasien diprediksi no disease, namun nyatanya dia terkena disease - False Positive : pasien diprediksi disease, namun nyatanya dia no disease
Error yang ingin kita kurangi adalah FN/Recall (Sensitivity)
5.4 ROC and AUC
Accuracy memiliki kekurangan untuk memperlihatkan kebaikan model dalam mengklasifikasi kedua kelas. Mengatasi kekurangan accuracy tersebut, maka mari menggunakan ROC dan AUC sebagai alat evaluasi selain Confusion Matrix.
5.4.1 Receiver-Operating Curve (ROC)
ROC adalah kurva yang menggambarkan hubungan antara True Positive Rate (Sensitivity atau Recall) dengan False Positive Rate (1-Specificity) pada setiap threshold. Model yang baik idealnya memiliki True Positive Rate yang tinggi dan False Positive Rate yang rendah. Note: Specificity adalah True Negative Rate.
pred_test_nb <- predict(model_naive, data_test, type="raw")# objek prediction
pred_roc_nb <- prediction(predictions = pred_test_nb[,"1"], # hanya mengambil peluang salah satu kelas (pada case ini yaitu democrat)
labels = data_test$target)perf <- plot(performance(prediction.obj = pred_roc_nb, # memanggil nilai roc_prediction yang sudah dihitung sebelumnya
measure = "tpr",
x.measure = "fpr"))
abline(0,1, lty=2) # harus dijalankan bersamaan dengan code plot() di atas
5.4.2 Area Under Curve (AUC)
Selanjutnya mari kita mencoba untuk AUCnya.
auc_pred <- performance(prediction.obj = pred_roc_nb,
measure = "auc")
auc_pred@y.values # tanda @ untuk mengakases nilai/bagian dari object auc## [[1]]
## [1] 0.8666667str(auc_pred)## Formal class 'performance' [package "ROCR"] with 6 slots
## ..@ x.name : chr "None"
## ..@ y.name : chr "Area under the ROC curve"
## ..@ alpha.name : chr "none"
## ..@ x.values : list()
## ..@ y.values :List of 1
## .. ..$ : num 0.867
## ..@ alpha.values: list()AUC = 0.8666667, maka dapat disimpulkan bahwa model kita sudah cukup baik dalam memisahkan kelas 1 dan 0 (disease dan no disease)
- ROC dan AUC sebagai alat evaluasi tambahan selain confusion matrix.
- ROC menggambarkan True Positive Rate (Recall) vs False Positive Rate. Kurva yang baik adalah kurva yang mendekati pojok kiri atas (Recall = 1, FPR = 0).
- AUC adalah luas area di bawah kurva ROC. Semakin mendekati nilai 1, model semakin baik dalam memisahkan kelas positif dan negatif.
6 Decision Tree
Decision Tree merupakan tree-based model yang cukup sederhana dengan performa yang robust/powerful untuk prediksi. Decision Tree menghasilkan visualisasi berupa pohon keputusan yang dapat diinterpretasi dengan mudah.
Karakter tambahan Decision Tree:
- Variable predictor diasumsikan saling dependent, sehingga dapat mengatasi multicollinearity.
- Dapat mengatasi nilai predictor numerik yang berupa outlier.
6.1 Model Fitting
model_dt <- ctree(formula = target ~.,
data = data_train_down,
control = ctree_control(mincriterion=0.90))
plot(model_dt, type = "simple")
## Prediction
# your code here
pred_dt <- predict(model_dt, data_test, type="response")6.2 Evaluasi Model Decision Tree
Untuk memeriksa performa model, kita dapat menggunakan
confusionMatrix(). Pastikan Anda mengatur status pelanggan
yang default sebagai kelas positif
(positive = "yes").
# your code here
confusionMatrix(pred_dt, data_test$target, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 23 11
## 1 8 19
##
## Accuracy : 0.6885
## 95% CI : (0.5571, 0.801)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 0.003287
##
## Kappa : 0.3759
##
## Mcnemar's Test P-Value : 0.646355
##
## Sensitivity : 0.6333
## Specificity : 0.7419
## Pos Pred Value : 0.7037
## Neg Pred Value : 0.6765
## Prevalence : 0.4918
## Detection Rate : 0.3115
## Detection Prevalence : 0.4426
## Balanced Accuracy : 0.6876
##
## 'Positive' Class : 1
## Pada kasus ini, yang manakah error yang kita ingin minimalisir? False Negative / False Positive? - False Negative : pasien diprediksi no disease, namun nyatanya dia terkena disease - False Positive : pasien diprediksi disease, namun nyatanya dia no disease
Error yang ingin kita kurangi adalah FN/Recall (Sensitivity)
6.2.1 Receiver-Operating Curve (ROC)
pred_test2 <- predict(model_dt, data_test, type="prob")# objek prediction
pred_roc2 <- prediction(predictions = pred_test2[,"1"], # hanya mengambil peluang salah satu kelas (pada case ini yaitu democrat)
labels = data_test$target)perf <- plot(performance(prediction.obj = pred_roc2, # memanggil nilai roc_prediction yang sudah dihitung sebelumnya
measure = "tpr",
x.measure = "fpr"))
abline(0,1, lty=2) # harus dijalankan bersamaan dengan code plot() di atas
6.2.2 Area Under Curve (AUC)
Selanjutnya mari kita mencoba untuk AUCnya.
auc_pred <- performance(prediction.obj = pred_roc2,
measure = "auc")
auc_pred@y.values # tanda @ untuk mengakases nilai/bagian dari object auc## [[1]]
## [1] 0.7290323str(auc_pred)## Formal class 'performance' [package "ROCR"] with 6 slots
## ..@ x.name : chr "None"
## ..@ y.name : chr "Area under the ROC curve"
## ..@ alpha.name : chr "none"
## ..@ x.values : list()
## ..@ y.values :List of 1
## .. ..$ : num 0.729
## ..@ alpha.values: list()7 Random Forest
Random Forest adalah salah satu jenis Ensemble Method yang terdiri dari banyak Decision Tree. Masing-masing Decision Tree memiliki karakteristik masing-masing dan tidak saling berhubungan. Random Forest memanfaatkan konsep Bagging (Bootstrap and Aggregation) dalam pembuatannya. Berikut adalah prosesnya:
- Bootstrap sampling: Membuat data dengan random sampling (with replacement) dari data keseluruhan dan mengizinkan adanya baris yang terduplikat.
- Dibuat 1 decision tree untuk masing-masing data hasil bootstrap.
Digunakan parameter
mtryuntuk memilih banyaknya calon prediktor secara random (Automatic Feature Selection) - Melakukan prediksi terhadap observasi yang baru untuk setiap Decision Tree.
- Aggregation: Menghasilkan satu prediksi tunggal untuk memprediksi.
- Kasus klasifikasi: majority voting
- Kasus regresi: rata-rata nilai target
Cek proporsi kelas target pada data train yang sudah dilakukan cross validation sebelumnya.
prop.table(table(data_train_down$target))##
## 0 1
## 0.5 0.5data_train_down[data_train_down$target == "1",]7.1 Model Fitting
set.seed(100)
control <- trainControl(method = "repeatedcv", number = 5, repeats = 3)
# pembuatan model random forest
model_rf <- train(target ~ .,data_train_down, method = "rf",
trControl = control)
# simpan model
saveRDS(model_rf, "model_rf.RDS")Salah satu kelemahan Random Forest adalah pembuatan model yang
membutuhkan waktu yang cukup lama. Practice yang baik saat selesai
melakukan training adalah menyimpan model tersebut ke dalam bentuk file
RDS dengan function saveRDS() agar model dapat langsung
digunakan tanpa harus training dari awal.
df_forest <- readRDS("model_rf.RDS")
df_forest## Random Forest
##
## 214 samples
## 13 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 171, 172, 171, 171, 171, 172, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.8080120 0.6160823
## 12 0.8001862 0.6007824
## 22 0.7956056 0.5916489
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.Penjelasan dari output summary model random forest:
- 214 samples -> jumlah baris pada data train yang digunakan dalam pembuatan model
- 13 predictor -> jumlah variabel prediktor pada data train kita
- 2 classes -> banyaknya kelas target yang ada pada data kita
- Summary of sample sizes -> banyaknya sample size pada data train hasil k-fold cross validation
- mtry dan accuracy menunjukkan banyaknya mtry yang digunakan dan nilai accuracy dari model masing-masing mtry. accuracy ini dapat dijadikan acuan model mana yang paling baik berdasarkan mtry-nya.
Bila dilihat dari summary model, dilakukan beberapa percobaan
mtry (jumlah prediktor yang dapat digunakan untuk splitting
node (1 prediktor bisa digunakan lebih dari 1 kali)). Di tiap repeats,
akan dicoba mtry yang berbeda (pemilihan angka mtry secara random juga).
Random forest akan secara otomatis memilih mtry yang menghasilkan
metrics evaluasi (dalam kasus ini Accuracy) terbaik.
Pada kasus ini model yang dipilih adalah dengan mtry = 2, yang memiliki akurasi tertinggi ketika diujikan ke data hasil boostrap sampling (bisa dianggap sebagai data train pada pembuatan decision tree pada random forest).
7.2 Out of Bag Error
df_forest$finalModel##
## Call:
## randomForest(x = x, y = y, mtry = param$mtry)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 20.56%
## Confusion matrix:
## 0 1 class.error
## 0 86 21 0.1962617
## 1 23 84 0.2149533Penjelasan summary df_forest$finalModel:
- Number of trees: 500 -> random forest membuat sebanyak 500 tree
- No. of variables tried at each split: 2 -> mtry : 2
- OOB estimate of error rate: 20.56% -> out-of-bag error dari out-of-bag sample (unseen data saat melakukan bootstrap sampling)
- Confusion matrix -> nilai confusion matrix untuk out-of-bag sample yang ada
varImp(df_forest) %>% plot()
Untuk variabel/prediktor yang berperan penting dalam pembuatan random forest, ada oldpeak dan thalach, dapat dilihat berdasarkan peringkatnya.
7.3 Prediction
pred_df <- predict(df_forest, data_test, type="raw")7.4 Model Evaluation
confusionMatrix(pred_df, data_test$target, positive="1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 27 7
## 1 4 23
##
## Accuracy : 0.8197
## 95% CI : (0.7002, 0.9064)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 4.35e-07
##
## Kappa : 0.6387
##
## Mcnemar's Test P-Value : 0.5465
##
## Sensitivity : 0.7667
## Specificity : 0.8710
## Pos Pred Value : 0.8519
## Neg Pred Value : 0.7941
## Prevalence : 0.4918
## Detection Rate : 0.3770
## Detection Prevalence : 0.4426
## Balanced Accuracy : 0.8188
##
## 'Positive' Class : 1
## 7.4.1 Receiver-Operating Curve (ROC)
pred_test_rf <- predict(model_rf, data_test, type="prob")# objek prediction
pred_roc_rf <- prediction(predictions = pred_test_rf[,"1"], # hanya mengambil peluang salah satu kelas (pada case ini yaitu democrat)
labels = data_test$target)perf <- plot(performance(prediction.obj = pred_roc_rf, # memanggil nilai roc_prediction yang sudah dihitung sebelumnya
measure = "tpr",
x.measure = "fpr"))
abline(0,1, lty=2) # harus dijalankan bersamaan dengan code plot() di atas
7.4.2 Area Under Curve (AUC)
Selanjutnya mari kita mencoba untuk AUCnya.
auc_pred <- performance(prediction.obj = pred_roc_rf,
measure = "auc")
auc_pred@y.values # tanda @ untuk mengakases nilai/bagian dari object auc## [[1]]
## [1] 0.9182796str(auc_pred)## Formal class 'performance' [package "ROCR"] with 6 slots
## ..@ x.name : chr "None"
## ..@ y.name : chr "Area under the ROC curve"
## ..@ alpha.name : chr "none"
## ..@ x.values : list()
## ..@ y.values :List of 1
## .. ..$ : num 0.918
## ..@ alpha.values: list()8 Kesimpulan
Setelah melakukan implementasi data pada model dengan 3 pendekatan yaitu Naive Bayes, Decision Tree, dan Random Forest, maka dapat disimpulkan bahwa performa yang dihasilkan model berbeda-beda.
Pada kasus ini, error yang kita ingin minimalisir adalah False Negative - False Negative : pasien diprediksi no disease, namun nyatanya dia terkena disease - False Positive : pasien diprediksi disease, namun nyatanya dia no disease
Error yang ingin kita kurangi adalah FN/Recall (Sensitivity).
Berdasarkan hal tersebut, mari kita bandingkan Recall (Sensitivity) pada ketiga model tersebut.
model_naive = 0.8000 - Naive Bayes AUC = 0.8666667
model_dt = 0.6333 - Decision Tree AUC = 0.7290323
model_rf = 0.7667 - Random Forest AUC = 0.9182796
confusionMatrix(pred_naive, data_test$target, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 25 6
## 1 6 24
##
## Accuracy : 0.8033
## 95% CI : (0.6816, 0.894)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 1.809e-06
##
## Kappa : 0.6065
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8000
## Specificity : 0.8065
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.8065
## Prevalence : 0.4918
## Detection Rate : 0.3934
## Detection Prevalence : 0.4918
## Balanced Accuracy : 0.8032
##
## 'Positive' Class : 1
## confusionMatrix(pred_dt, data_test$target, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 23 11
## 1 8 19
##
## Accuracy : 0.6885
## 95% CI : (0.5571, 0.801)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 0.003287
##
## Kappa : 0.3759
##
## Mcnemar's Test P-Value : 0.646355
##
## Sensitivity : 0.6333
## Specificity : 0.7419
## Pos Pred Value : 0.7037
## Neg Pred Value : 0.6765
## Prevalence : 0.4918
## Detection Rate : 0.3115
## Detection Prevalence : 0.4426
## Balanced Accuracy : 0.6876
##
## 'Positive' Class : 1
## confusionMatrix(pred_df, data_test$target, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 27 7
## 1 4 23
##
## Accuracy : 0.8197
## 95% CI : (0.7002, 0.9064)
## No Information Rate : 0.5082
## P-Value [Acc > NIR] : 4.35e-07
##
## Kappa : 0.6387
##
## Mcnemar's Test P-Value : 0.5465
##
## Sensitivity : 0.7667
## Specificity : 0.8710
## Pos Pred Value : 0.8519
## Neg Pred Value : 0.7941
## Prevalence : 0.4918
## Detection Rate : 0.3770
## Detection Prevalence : 0.4426
## Balanced Accuracy : 0.8188
##
## 'Positive' Class : 1
## Berdasarkan hasil model diatas, dapat dilihat bahwa model dengan Naive Bayes lebih baik dalam melakukan prediksi pada dataset nantinya.