Imbalanced Data Handling

Library

library(themis)
library(tidyverse)
library(tidymodels)
library(DataExplorer)
library(readxl)
library(caret)
library(ggplot2)
library(dplyr)
library(DescTools)
library(e1071)
library(ROCR)

Data

Data yang digunakan dalam materi ini adalah data Pasien yang terdiri dari Gender, Riwayat Penyakit Jantung, Riwayat Hipertensi, Status Pernikahan, berdasarkan keempat variabel tersebut akan diperiksa apakah pasien menderita penyakit Stroke/Tidak.

pasien<- read_xlsx("D:/Data Stroke.xlsx")
pasien<- na.omit(pasien)
head(pasien)

## # A tibble: 6 × 5
##   gender hypertension heart_disease ever_married stroke
##   <chr>  <chr>        <chr>         <chr>        <chr> 
## 1 Male   No           No            No           No    
## 2 Male   Yes          No            Yes          No    
## 3 Female No           No            No           No    
## 4 Female No           No            Yes          No    
## 5 Male   No           No            No           No    
## 6 Female No           No            Yes          No

pasien$gender <- as.factor(pasien$gender)
pasien$hypertension <- as.factor(pasien$hypertension)
pasien$heart_disease <- as.factor(pasien$heart_disease)
pasien$ever_married <- as.factor(pasien$ever_married)

pasien$stroke <- as.factor(pasien$stroke)

Eksplorasi Data

plot_intro(data = pasien)

pasien%>%count(stroke)

## # A tibble: 2 × 2
##   stroke     n
##   <fct>  <int>
## 1 No     42617
## 2 Yes      783

plotdata <- pasien %>%
  count(stroke) %>%
  arrange(desc(stroke)) %>%
  mutate(prop = round(n*100/sum(n), 1),
         lab.ypos = cumsum(prop) - 0.5*prop)

# Pie Chart
ggplot(plotdata, aes(x = "", y = prop, fill = stroke)) +
  geom_bar(width = 1, stat = "identity", color = "white") +
  coord_polar("y", start = 0)+
  geom_text(aes(y = lab.ypos, label = prop), color = "black")+
  theme_void()+
  labs(title = "Persentase Pasien Stroke")

Berdasarkan hasil eksplorasi di atas terlihat bahwa data Pasien Stroke merupakan data yang tidak seimbang karena jumlah pasien stroke stroke hanya 1,8 % dari keseluruhan data.

Partisi Data

Data Pasien dipartisi dengan proporsi data training sebesar 80% dan testing 20%.

set.seed(1001)
train_pasien_y <- createDataPartition(pasien$stroke, p = 0.80, list=FALSE)
trainData <- pasien[train_pasien_y,]
testData <- pasien[-train_pasien_y,]

n<-nrow(trainData)
n

## [1] 34721

trainData%>%count(stroke)

## # A tibble: 2 × 2
##   stroke     n
##   <fct>  <int>
## 1 No     34094
## 2 Yes      627

testData%>%count(stroke)

## # A tibble: 2 × 2
##   stroke     n
##   <fct>  <int>
## 1 No      8523
## 2 Yes      156

Naive Bayes dengan Imbalanced Data

Proses Training

NBClassifier <- naiveBayes(stroke ~., data = trainData)
NBClassifier

## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##         No        Yes 
## 0.98194176 0.01805824 
## 
## Conditional probabilities:
##      gender
## Y           Female         Male        Other
##   No  0.5910424122 0.4086349504 0.0003226374
##   Yes 0.5438596491 0.4561403509 0.0000000000
## 
##      hypertension
## Y             No        Yes
##   No  0.90901625 0.09098375
##   Yes 0.74800638 0.25199362
## 
##      heart_disease
## Y             No        Yes
##   No  0.95673726 0.04326274
##   Yes 0.77671451 0.22328549
## 
##      ever_married
## Y            No       Yes
##   No  0.3595647 0.6404353
##   Yes 0.1052632 0.8947368

Proses Testing

# Predict using Naive Bayes
testData$predicted <- predict(NBClassifier,testData)
testData$actual <- testData$stroke

#confusion matrix
confusionMatrix(factor(testData$predicted),
                factor(testData$actual))

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No  8523  156
##        Yes    0    0
##                                          
##                Accuracy : 0.982          
##                  95% CI : (0.979, 0.9847)
##     No Information Rate : 0.982          
##     P-Value [Acc > NIR] : 0.5213         
##                                          
##                   Kappa : 0              
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 1.000          
##             Specificity : 0.000          
##          Pos Pred Value : 0.982          
##          Neg Pred Value :   NaN          
##              Prevalence : 0.982          
##          Detection Rate : 0.982          
##    Detection Prevalence : 1.000          
##       Balanced Accuracy : 0.500          
##                                          
##        'Positive' Class : No             
##

Naive Bayes dengan Balanced data (`Undersampling`)

Metode Random Undersampling digunakan untuk menyeimbangkan sebaran setiap kelas dengan menghapus sampel kelas mayoritas secara acak.