Prediksi data imbalance Stroke dengan Random Forest
Farhan Adham Irawan
Mei 10, 2021
1 Pendahuluan
Dalam dunia data, istilah data imbalance akan seringkali ditemukan, salah satu contohnya adalah ketika kita ingin membantu tim medis untuk memprediksi orang yang terkena resiko stroke atau tidak. Tentu kita ingin machine learning yang kita buat memiliki performa setinggi mungkin. Maka dari itu pada kesempatan kali ini, saya akan mencoba mengimplementasikan beberapa ilmu untuk mengatasi data imbalance yang saya peroleh melalui pelatihan Data Science di Algoritma Data Science
Data yang saya gunakan adalah data stroke prediction. Data tersebut dapat di download melalui Kaggle serta Algoritma yang akan digunakan adalah Random Forest.
2 Library
Pertama-tama panggil dahulu library() yang dibutuhkan;
library(tidyverse)
library(class)
library(gtools)
library(gmodels)
library(caret)
library(doSNOW)Setelah melakukan import library yang digunakan, selanjutnya adalah import dataset yang diperlukan
stroke <- read.csv("healthcare-dataset-stroke-data.csv")
str(stroke)## 'data.frame': 5110 obs. of 12 variables:
## $ id : int 9046 51676 31112 60182 1665 56669 53882 10434 27419 60491 ...
## $ gender : Factor w/ 3 levels "Female","Male",..: 2 1 2 1 1 2 2 1 1 1 ...
## $ age : num 67 61 80 49 79 81 74 69 59 78 ...
## $ hypertension : int 0 0 0 0 1 0 1 0 0 0 ...
## $ heart_disease : int 1 0 1 0 0 0 1 0 0 0 ...
## $ ever_married : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 1 2 2 ...
## $ work_type : Factor w/ 5 levels "children","Govt_job",..: 4 5 4 4 5 4 4 4 4 4 ...
## $ Residence_type : Factor w/ 2 levels "Rural","Urban": 2 1 1 2 1 2 1 2 1 2 ...
## $ avg_glucose_level: num 229 202 106 171 174 ...
## $ bmi : Factor w/ 419 levels "10.3","11.3",..: 240 419 199 218 114 164 148 102 419 116 ...
## $ smoking_status : Factor w/ 4 levels "formerly smoked",..: 1 2 2 3 2 1 2 2 4 4 ...
## $ stroke : int 1 1 1 1 1 1 1 1 1 1 ...Penjelasan dari setiap variable dalam data;
id = Nomor ID Pasien
gender = Jenis Kelamin
age = Usia
Hypertension = 0 jika pasien tidak mempunyai hipertensi, 1 jika pasien mempunyai hipertensi
heart_disease = 0 jika pasien tidak mempunyai penyakit jantung, 1 jika pasien mempunyai penyakit jantung
ever_married = Status perkawinan
work_type = Status pekerjaan
Residence_type = Tempat tinggal desa / kota
avg_glucose_level = Rata rata gula darah dalam tubuh
bmi = Berat badan
smoking_status = Status merokok
stroke = 1 jika pasien stroke, 0 jika pasien tidak stroke
Dibawah ini adalah gambaran singkat tentang data yang akan digunakan
head(stroke)3 Data Manipulation
Pada data Stroke masih terdapat beberapa data yang tidak tepat formatnya, maka dari itu kita harus mengubah format datanya agar benar
stroke %>%
mutate(hypertension = factor(hypertension,
levels = c(0,1),
labels = c("No","Yes")),
heart_disease = factor(heart_disease,
levels = c(0,1),
labels = c("No","Yes")),
stroke = factor(stroke,
levels = c(0,1),
labels = c("No","Yes")),
bmi = as.numeric(as.character(bmi))
) -> stroke
#hilangkan kolom id karna tidak berpengaruh
stroke$id = NULL
glimpse(stroke)## Rows: 5,110
## Columns: 11
## $ gender <fct> Male, Female, Male, Female, Female, Male, Male, Fema~
## $ age <dbl> 67, 61, 80, 49, 79, 81, 74, 69, 59, 78, 81, 61, 54, ~
## $ hypertension <fct> No, No, No, No, Yes, No, Yes, No, No, No, Yes, No, N~
## $ heart_disease <fct> Yes, No, Yes, No, No, No, Yes, No, No, No, No, Yes, ~
## $ ever_married <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, Yes, Yes, Yes~
## $ work_type <fct> Private, Self-employed, Private, Private, Self-emplo~
## $ Residence_type <fct> Urban, Rural, Rural, Urban, Rural, Urban, Rural, Urb~
## $ avg_glucose_level <dbl> 228.69, 202.21, 105.92, 171.23, 174.12, 186.21, 70.0~
## $ bmi <dbl> 36.6, NA, 32.5, 34.4, 24.0, 29.0, 27.4, 22.8, NA, 24~
## $ smoking_status <fct> formerly smoked, never smoked, never smoked, smokes,~
## $ stroke <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Ye~Lalu kita akan coba memerika apakah terdapat missing value dalam dataset kita
colSums(is.na(stroke))## gender age hypertension heart_disease
## 0 0 0 0
## ever_married work_type Residence_type avg_glucose_level
## 0 0 0 0
## bmi smoking_status stroke
## 201 0 0Kita akan mencoba mengisi nilai kosong tersebut dengan metode Imputation. <missForest> adalah salah satu package yang dapat mengisi nilai NA pada variabel secara otomatis
library(missForest)
new_stroke <- missForest(stroke)## missForest iteration 1 in progress...done!
## missForest iteration 2 in progress...done!
## missForest iteration 3 in progress...done!
## missForest iteration 4 in progress...done!stroke <- new_stroke$ximpSetelah nilai NA berhasil di atasi, kita akan melihat seberapa ekstrim tingkat keseimbangan data pada Dataset Stroke ini
prop.table(table(stroke$stroke))##
## No Yes
## 0.95127202 0.04872798table(stroke$stroke)##
## No Yes
## 4861 2494 Splitting Data
Sebelum melakukan pembuatan model, kita harus melihat proporsi jumlah kelas target variabel data train_stroke
set.seed(1202)
idx <- createDataPartition(stroke$stroke, p = 0.8, list = F)
train_stroke = stroke[idx,]
test_stroke = stroke[-idx,]
table(train_stroke$stroke)##
## No Yes
## 3889 2005 Feature Selection
Untuk mendapat peforma tertinggi dalam pembuatan suatu model, kita harus melakukan pemilihan variabel untuk menjadi input dalam machine learning, untuk melakukannya ada sebuah library bernama Boruta yang bisa melakukan Feature Selection secara otomatis
library(Boruta)
set.seed(321)
need <- Boruta(stroke ~., data = stroke, doTrace = 2)par(mar = c(2,2,2,2))
plot(need, cex.axis = .7, las = 2)
Bar yang berwarna hijau mengindikasikan bahwa variabel tersebut layak untuk dipertahankan, sedangkan yang merah mengindikasikan sebaiknya untuk dibuang
need$finalDecision## gender age hypertension heart_disease
## Rejected Confirmed Confirmed Confirmed
## ever_married work_type Residence_type avg_glucose_level
## Confirmed Confirmed Rejected Rejected
## bmi smoking_status
## Confirmed Rejected
## Levels: Tentative Confirmed RejectedDiatas adalah hasil dari implementasi library Boruta, kita bisa mengetahui mana saja variable yang berguna dan tidak.
use <- c("age","hypertension","heart_disease","ever_married","work_type",
"bmi")6 Modelling
Kita akan melakukan testing dengan 3 cara, untuk mengatasi dataset imbalance;
1) Hanya dengan Cross Validasi biasa
2) Cross Validasi + Up-Sampling
3) Cross Validasi + Bootstrap Aggregation (Bagging)
6.1 Cara ke 1
kita telah melakukan Feature Selection, pertama tama kita akan mencoba melakukan percobaan menggunakan seluruh variabel dan dilanjutkan dengan membuang beberapa variabel seperti yang dilakukan pada tahap Feature Selection
Karena Random Forest merupakan Algoritma yang cukup berat dan memakan waktu lama untuk proses komputasinya, kita akan melakukan Computing Paralel untuk mempercepat waktu training nya.
Perlu diingat, dalam melakukan proses Computing Paralel, kita perlu menyesuaikan jumlah paralel dengan jumlah RAM di laptop / PC kita. Karena jika kita tidak memperhatikan jumlah paralel dengan kapasitas RAM, maka laptop / PC kita akan hang seketika.
Dalam kesempatan kali ini, saya hanya akan melakukan fungsi paralel tersebut sebanyak 3 buah
ctrl <- trainControl(method = "cv", number = 5)
library(doSNOW)
cl <- makeCluster(3, type = "SOCK") #sesuaikan dengan kapasitas RAM
registerDoSNOW(cl)
# dengan seluruh variabel
set.seed(12)
mod1 <- train(stroke ~., data = train_stroke,
method = "rf", trControl = ctrl)
# variabel dari hasil feature selection
set.seed(12)
mod2 <- train(stroke ~ age + hypertension +heart_disease +
ever_married + work_type + bmi,
data = train_stroke,
method = "rf", trControl = ctrl)
stopCluster(cl)6.2 Evaluasi Cara ke 1
Evaluasi model pertama dengan seluruh variable
confusionMatrix(predict(mod1, test_stroke), test_stroke$stroke,
mode = "everything", positive = "Yes") -> cf1.1
cf1.1$byClass[6]## Recall
## 0Evaluasi model kedua dengan variable hasil Feature Selection
confusionMatrix(predict(mod2, test_stroke), test_stroke$stroke,
mode = "everything", positive = "Yes") -> cf1.2
cf1.2$byClass[6]## Recall
## 0Ternyata kedua model tersebut memberi hasil yang buruk dikarenakan jumlah Data Imbalance yang terlu ekstrim
6.3 Cara ke 2
Sama dengan cara pertama di atas, namun kali ini kita akan mencoba menyeimbangkan dataset Stroke tersebut dengan cara menyamakan jumlah variabel target Yes & No sehingga jumlahnya sama banyak
set.seed(12)
train_up_1 <- upSample(x = train_stroke, y = train_stroke$stroke,
yname = "label")
head(train_up_1)table(train_up_1$label)##
## No Yes
## 3889 3889Dengan begini kita telah berusaha untuk menyeimbangkan dataset yang kita miliki, selanjutnya kita akan mencoba membuat model prediktif dengan dataset baru tersebut
ctrl <- trainControl(method = "cv", number = 5)
library(doSNOW)
cl <- makeCluster(3, type = "SOCK") #sesuaikan dengan kapasitas RAM
registerDoSNOW(cl)
# dengan seluruh variabel
set.seed(12)
mod2.1 <- train(label ~. -stroke, data = train_up_1,
method = "rf", trControl = ctrl)
# variabel dari hasil feature selection
set.seed(12)
mod2.2 <- train(label ~ age + hypertension +heart_disease +
ever_married + work_type + bmi,
data = train_up_1,
method = "rf", trControl = ctrl)
stopCluster(cl)6.4 Evaluasi Cara ke 2
Evaluasi model pertama dengan seluruh variable
confusionMatrix(predict(mod2.1, test_stroke), test_stroke$stroke,
mode = "everything", positive = "Yes")-> cf2.1
cf2.1$byClass[6]## Recall
## 0.08163265Evaluasi model kedua dengan variable hasil Feature Selection
confusionMatrix(predict(mod2.2, test_stroke), test_stroke$stroke,
mode = "everything", positive = "Yes")-> cf2.2
cf2.2$byClass[6]## Recall
## 0.122449Jika ditinjau dari nilai Recall maka model dengan variabel yang telah di Feature Selection memberikan keunggulan ketimbang yang tidak di Feature Selection
6.5 Cara ke 3
Cara ini adalah cara terakhir yang dilakukan oleh saya untuk mengatasi Data Imbalance. Teknik ini dinamakan Bootstrap Aggregation (Bagging)
Cara kerja teknik Bagging dapat dilihat pada gambar dibawah ini
Teknik bagging akan membagi data training T menjadi beberapa bagian, misal sejumlah m. Kemudian dibuat model klasifikasi C sejumlah m. Hasil prediksi setiap model P juga akan berjumlah m. Untuk mendapatkan prediksi akhir Pf dilakukan dengan cara voting dari hasil prediksi setiap model klasifikasi C.
Ciri utama dari teknik bagging ini adalah setiap model klasifikasi menggunakan algoritma yang sama. Artinya jika C1 menggunakan algoritma Random Forest maka C2, C3 … Cm juga menggunakan algoritma Random Forest.
table(train_stroke$stroke)##
## No Yes
## 3889 200Untuk kasus klasifikasi tidak seimbang pada data stroke yang memiliki 3889 instance No dan 200 instance Yes, maka pembagian data dapat dilakukan dengan membagi 3889 instance No menjadi 20 bagian dimana setiap bagian terdiri dari 194 instance No. Sehingga akan memiliki 20 bagian data dimana setiap bagiannya terdiri atas 194 instance No dan 200 instance Yes. Dengan pembagian ini maka data akan seimbang tanpa harus menghilangkan data dengan undersampling atau menambah data dengan oversampling
Cara untuk melakukan teknik ini adalah dengan cara memberi label pada setiap instance class, untuk lebih jelasnya perhatikan kode dibawah ini
train_stroke$urutan = rep("", nrow(train_stroke))
#memberi label pada class No & Yes
bagian = 20
rep(seq(bagian), nrow(train_stroke %>%
filter(stroke == "No"))) -> as
as[-seq(c(length(as)- nrow(train_stroke %>%
filter(stroke == "No"))))] -> as
train_stroke[train_stroke$stroke == "No",]$urutan <- as
train_stroke[train_stroke$stroke == "Yes",]$urutan <- "0"
head(train_stroke)tail(train_stroke)table(train_stroke$urutan)##
## 0 1 10 11 12 13 14 15 16 17 18 19 2 20 3 4 5 6 7 8
## 200 194 194 194 195 195 195 195 195 195 195 195 194 195 194 194 194 194 194 194
## 9
## 194urutan 0 mewakili class Yes, sedangkan urutan 1-20 mewakili class No. untuk menyeimbangkan class Yes & No, class No memiliki jumlah yang banyak sehingga dibagi menjadi 20 bagian, setiap bagiannya hanya tersisa 194 / 195 baris saja.
Langkah selanjutnya kita akan membuat model secara berulang sebanyak 20kali, dimana data train nya terdiri dari gabungan
train_stroke[“urutan”] == 0 & train_stroke[“urutan”] == 1
train_stroke[“urutan”] == 0 & train_stroke[“urutan”] == 2
train_stroke[“urutan”] == 0 & train_stroke[“urutan”] == 3
..
..
train_stroke[“urutan”] == 0 & train_stroke[“urutan”] == 20
Pembuatan model dengan Teknik Bagging + Cross Validasi dengan seluruh variabel
newdata3.1 = NULL
for(i in seq(bagian)) {
tryCatch({
training = NULL
train1 = train_stroke %>%
filter(urutan == 0)
train2 = train_stroke %>%
filter(urutan == i)
training = rbind(train1, train2)
training$urutan = NULL
#proses paralel computing agar bisa lebih cepat dalam proses training
cl = makeCluster(3, type = "SOCK")
registerDoSNOW(cl)
set.seed(12)
mod3.1 <- train(stroke ~.,
data = training,
method = "rf", trControl = ctrl)
prediksi <- predict(mod3.1, test_stroke)
newdata3.1 = rbind(newdata3.1,prediksi)
stopCluster(cl)
}, error = function(e) {message("eror but no problem")}
)
mod3.1 = NULL
}pred3.1 = sapply(seq(ncol(newdata3.1)),
FUN = function(i) {
table(newdata3.1[,i]) %>% sort(decreasing = T) %>% names() %>% head(1)
}) Pembuatan model dengan Teknik Bagging + Cross Validasi dengan variabel yang telah di Feature Selection
newdata3.2 = NULL
for(i in seq(bagian)) {
tryCatch({
training = NULL
train1 = train_stroke %>%
filter(urutan == 0)
train2 = train_stroke %>%
filter(urutan == i)
training = rbind(train1, train2)
training$urutan = NULL
#proses paralel computing agar bisa lebih cepat dalam proses training
cl = makeCluster(3, type = "SOCK")
registerDoSNOW(cl)
set.seed(12)
mod3.2 <- train(stroke ~ age + hypertension +heart_disease +
ever_married + work_type + bmi,
data = training,
method = "rf", trControl = ctrl)
prediksi <- predict(mod3.2, test_stroke)
newdata3.2 = rbind(newdata3.2,prediksi)
stopCluster(cl)
}, error = function(e) {message("eror but no problem")}
)
mod3.2 = NULL
}pred3.2 = sapply(seq(ncol(newdata3.2)),
FUN = function(i) {
table(newdata3.2[,i]) %>% sort(decreasing = T) %>% names() %>% head(1)
}) Setelah berhasil menyimpan hasil prediksi, kita akan mencoba melihat output yang dihasilkan dari Algoritma Random Forest
head(pred3.1)## [1] "2" "1" "2" "2" "2" "2"head(pred3.2)## [1] "2" "1" "2" "2" "2" "2"Ternyata class Yes & No berubah menjadi angka 1 & 2, untuk mengatasinya kita bisa melihat siapakah angka 1 dan angka 2 itu
data.frame(angka = as.integer(test_stroke$stroke) %>% unique(),
label = unique(test_stroke$stroke))Ternyata class Yes berubah menjadi angka 2, sedangkan No berubah menjadi angka 1. Selanjutnya kita akan mengubah class 1 & 2 yang ada pada pred3.1 & pred3.2 menjadi class Yes & No
factor(pred3.1, levels = c(1,2), labels = c("No","Yes")) -> pred3.1
factor(pred3.2, levels = c(1,2), labels = c("No","Yes")) -> pred3.26.6 Evaluasi Cara ke 3
Evaluasi model pertama dengan seluruh variabel
confusionMatrix(pred3.1, test_stroke$stroke,
mode = "everything", positive = "Yes") -> cf3.1
cf3.1$byClass[6]## Recall
## 0.8163265Evaluasi model kedua dengan variable hasil Feature Selection
confusionMatrix(pred3.2, test_stroke$stroke,
mode = "everything", positive = "Yes") -> cf3.2
cf3.2$byClass[6]## Recall
## 0.83673477 Kesimpulan
Kita telah melakukan berbagai macam percobaan untuk meningkatkan peforma Machine Learning dalam upaya untuk memprediksi kasus Stroke. Dibawah ini adalah ringkasan Confussion Matrix dengan menggunakan seluruh variabel prediktor
data.frame(cara_ke_1 = c(cf1.1$overall[1],cf1.1$byClass[6]),
cara_ke_2 = c(cf2.1$overall[1],cf2.1$byClass[6]),
cara_ke_3 = c(cf3.1$overall[1],cf3.1$byClass[6]))
Dibawah ini adalah ringkasan Confussion Matrix dengan menggunakan beberapa variabel yang telah dilakukan proses Feature Selection
data.frame(cara_ke_1 = c(cf1.2$overall[1],cf1.2$byClass[6]),
cara_ke_2 = c(cf2.2$overall[1],cf2.2$byClass[6]),
cara_ke_3 = c(cf3.2$overall[1],cf3.2$byClass[6]))Ternyata jika dibandingkan hasil Accuracy dan Recall antara menggunakan seluruh variabel dengan menggunakan teknik Feature Seelction memiliki kelebihan & kekurangannya masing masing. Jika Fokus pada Accuracy saja maka Machine Learning dengan seluruh variabel prediktor memiliki tingkat Accuracy yang lebih tinggi. Namun jika ditinjau melalui nilai Recall maka variabel yang telah di Feature Selection memiliki tingkat Recall yang lebih tinggi.
Jika melihat kebutuhan, saya pribadi lebih mempertimbangkan nilai Recall sebagai ukuran utama metriksnya, karena kita ingin memprediksi “Yes” sebanyak mungkin meskipun itu salah prediksi (False Negatif). Tujuannya adalah siapapun yang diprediksi Stroke dapat dilakukan tindakan sesegera mungkin untuk mencegah / mengobatinya.