Prediksi data imbalance Stroke menggunakan Logistik Regression
Farhan Adham Irawan
Mei 6, 2021
1 Objective
Pada kesempatan kali ini saya akan mencoba melakukan suatu prediksi dengan menggunakan dataset penyakit Stroke. Algoritma yang akan digunakan adalah Algortima Logistik Regression dimana Algoritma tersebut tergolong dalam Supervised Learning.
2 Library & Setup
Pertama-tama panggil dahulu library() yang dibutuhkan;
library(tidyverse)
library(class)
library(gtools)
library(gmodels)
library(missForest)
library(caret)
library(doSNOW)Data yang saya gunakan adalah data tentang penyakit Stroke yang menggunakan beberapa parameter sebagai penentunya. Data tersebut dapat di download melalui Kaggle
stroke <- read.csv("C:/Users/ADAM/Downloads/Compressed/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
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$ximp4 Pre-processing Data
prop.table(table(stroke$stroke))##
## No Yes
## 0.95127202 0.04872798table(stroke$stroke)##
## No Yes
## 4861 2495 Splitting Data
Sebelum melakukan pembuatan model, kita harus melihat proporsi jumlah kelas target variabel data train_stroke
set.seed(123)
idx <- createDataPartition(stroke$stroke, p = 0.8, list = F)
train_stroke = stroke[idx,]
test_stroke = stroke[-idx,]
table(train_stroke$stroke)##
## No Yes
## 3889 200Terlihat jumlah class data yang sangat tidak seimbang, kita akan coba mengatasi masalah ini dengan teknik Bagging (Bootstrap Aggregating)
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 KNN maka C2, C3 … Cm juga menggunakan algoritma KNN.
Untuk 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.
6 Modelling & Prediction
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
newdata = NULL
for(i in seq(bagian)) {
tryCatch( {
train = NULL
train1 = train_stroke %>%
filter(urutan == 0)
train2 = train_stroke %>%
filter(urutan == i)
train = rbind(train1, train2)
#proses paralel computing agar bisa lebih cepat dalam proses training
cl = makeCluster(3, type = "SOCK")
registerDoSNOW(cl)
set.seed(101)
mod <- glm(stroke ~. -urutan,
data = train,
family = "binomial")
set.seed(101)
mod_step = step(mod, direction = "backward", trace = 0)
stopCluster(cl)
prediksi <- predict(mod_step, test_stroke, type = "response")
newdata = rbind(newdata,prediksi)
}, error = function(e) {message("eror but no problem")}
)
mod = NULL
mod_step = NULL
}## eror but no problem
## eror but no problemLalu seluruh hasil dari prediksi tersebut akan disimpan dalam suatu dataframe yang bernama newdata
newdata = as.data.frame(newdata)
head(newdata[,c(1:5)])dim(newdata)## [1] 18 10217 Evaluation
#membuat rata rata dari 18 prediksi yang ada
test_stroke$pred_prob = sapply(seq(ncol(newdata)), FUN = function(x) mean(newdata[[x]]))
test_stroke %>%
mutate(pred_stroke = ifelse(pred_prob > 0.5, "Yes", "No")) -> test_stroke
confusionMatrix(test_stroke$stroke, as.factor(test_stroke$pred_stroke),
positive = "Yes", mode = "everything")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 704 268
## Yes 7 42
##
## Accuracy : 0.7307
## 95% CI : (0.7023, 0.7577)
## No Information Rate : 0.6964
## P-Value [Acc > NIR] : 0.0089
##
## Kappa : 0.1648
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.13548
## Specificity : 0.99015
## Pos Pred Value : 0.85714
## Neg Pred Value : 0.72428
## Precision : 0.85714
## Recall : 0.13548
## F1 : 0.23398
## Prevalence : 0.30362
## Detection Rate : 0.04114
## Detection Prevalence : 0.04799
## Balanced Accuracy : 0.56282
##
## 'Positive' Class : Yes
## 8 Conclusion
Data Stroke adalah salah satu contoh data dengan imbalance yang cukup ekstrim, sehingga kita memerlukan teknik imbalance yang tepat guna memprediksi class Yes pada penderita Stroke. Lalu apa jadinya jika dalam menghadapi imbalance ekstrim tidak menggunakan bantuan teknik apapun?
saya pribadi sebelumnya telah mencoba cara itu, dan hasilnya benar benar buruk, karena seluruh prediksi mengindikasikan class No, tidak terdapat class Yes satupun. sehingga menyebabkan nilai Recall menjadi 0.
Apabila tujuan kita untuk mendeteksi potensi Stroke pada tiap tiap orang, maka indikator Precision sangat tepat digunakan. Jika menggunakan teknik Bagging ini, Precision dalam model tersebut mencapai 85%