Kelompok 2 - Random Forest
Kelompok 2 Kelas 3SE3
3/5/2023
Business Understanding
Diabetes adalah kondisi dimana sel-sel tubuh yang tidak bisa menyerap cukup glukosa gula (sumber utama energi tubuh) dari darah, akibat kurangnya hormon insulin yang biasa diproduksi oleh prankeas. Glukosa yang tidak diserap sel tubuh dengan baik akan menumpuk dalam darah dan dapat menimbulkan berbagai gangguan pada organ tubuh. Jika tidak terkontrol dengan baik, diabetes dapat menimbulkan komplikasi yang berisiko mengancam nyawa penderitanya. Diabetes dapat dipengaruhi oleh berbagai faktor, terutama mengenai gaya hidup seseorang.
Tanda-tanda seseorang mengalami diabetes dapat dilihat dari beberapa kriteria sehingga penyakit ini bisa diantisipasi sejak dini. Maka dari itu, diperlukan sebuah pengklasifikasian untuk melihat apakah seseorang menderita diabetes atau tidak. National Institute of Diabetes and Digestive and Kidney Disease mengumpulkan data yang berisi delapan variabel yang dilengkapi dengan label apakah seseorang mengalami diabetes atau tidak. Delapan variabel tersebut adalah umur masa kehamilan, jumlah glukosa, tekanan darah, ketebalan kulit, jumlah insulin, indeks masa tubuh (BMI), Diabetes Pedigree Function, dan Umur. Data yang dikumpulkan tersebut merupakan data dari pasien perempuan yang minimal berumur 21 tahun dan berasal dari keturunan Indian Pima, sekelompok penduduk asli Amerika yang tinggal di Arizona dan sebagian Meksiko.
Data Understanding
Load Data dan Library
LIBRARY
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.10
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.0.2 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(skimr)
library(VIM)## Loading required package: colorspace## Loading required package: grid## VIM is ready to use.## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleeplibrary(performanceEstimation)
library(caret)## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## liftlibrary(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithslibrary(imbalance)DATA
diabetes<-read.csv("diabetes.csv", header = TRUE, sep = ",")
head(diabetes)## X Pregnancies Glucose BloodPressure SkinThickness Insulin BMI
## 1 1 6 148 72 35 NA 33.6
## 2 2 1 85 66 29 NA 26.6
## 3 3 8 183 64 NA NA 23.3
## 4 4 1 89 66 23 94 28.1
## 5 5 NA 137 40 35 168 43.1
## 6 6 5 116 74 NA NA 25.6
## DiabetesPedigreeFunction Age Outcome
## 1 0.627 50 yes
## 2 0.351 31 no
## 3 0.672 32 yes
## 4 0.167 21 no
## 5 2.288 33 yes
## 6 0.201 30 noStruktur Data
Untuk mengetahui struktur dari sebuah data dapat digunakan fungsi str() (str-ucture). Dengan fungsi ini dapat diperoleh informasi lengkap dari sebuah data frame seperti jumlah observasi dan variabel, nama-nama variabel, tipe variabel, dan beberapa nilai baris pertama untuk masing-masing variabel.
df<-data.frame(diabetes[,-1])
str(df)## 'data.frame': 768 obs. of 9 variables:
## $ Pregnancies : int 6 1 8 1 NA 5 3 10 2 8 ...
## $ Glucose : int 148 85 183 89 137 116 78 115 197 125 ...
## $ BloodPressure : int 72 66 64 66 40 74 50 NA 70 96 ...
## $ SkinThickness : int 35 29 NA 23 35 NA 32 NA 45 NA ...
## $ Insulin : int NA NA NA 94 168 NA 88 NA 543 NA ...
## $ BMI : num 33.6 26.6 23.3 28.1 43.1 25.6 31 35.3 30.5 NA ...
## $ DiabetesPedigreeFunction: num 0.627 0.351 0.672 0.167 2.288 ...
## $ Age : int 50 31 32 21 33 30 26 29 53 54 ...
## $ Outcome : chr "yes" "no" "yes" "no" ...Berdasarkan output di atas diketahui terdapat 768 observasi dan 9 atribut/variabel. Untuk struktur data, 8 variabel independen bersifat numeric dan 1 variabel dependen, yaitu Outcome, bersifat character.
Mengubah Variabel Outcome menjadi Tipe Factor
df<-as.data.frame(unclass(df), stringsAsFactors = TRUE)
#Cek Ulang
str(df)## 'data.frame': 768 obs. of 9 variables:
## $ Pregnancies : int 6 1 8 1 NA 5 3 10 2 8 ...
## $ Glucose : int 148 85 183 89 137 116 78 115 197 125 ...
## $ BloodPressure : int 72 66 64 66 40 74 50 NA 70 96 ...
## $ SkinThickness : int 35 29 NA 23 35 NA 32 NA 45 NA ...
## $ Insulin : int NA NA NA 94 168 NA 88 NA 543 NA ...
## $ BMI : num 33.6 26.6 23.3 28.1 43.1 25.6 31 35.3 30.5 NA ...
## $ DiabetesPedigreeFunction: num 0.627 0.351 0.672 0.167 2.288 ...
## $ Age : int 50 31 32 21 33 30 26 29 53 54 ...
## $ Outcome : Factor w/ 2 levels "no","yes": 2 1 2 1 2 1 2 1 2 2 ...head(df)## Pregnancies Glucose BloodPressure SkinThickness Insulin BMI
## 1 6 148 72 35 NA 33.6
## 2 1 85 66 29 NA 26.6
## 3 8 183 64 NA NA 23.3
## 4 1 89 66 23 94 28.1
## 5 NA 137 40 35 168 43.1
## 6 5 116 74 NA NA 25.6
## DiabetesPedigreeFunction Age Outcome
## 1 0.627 50 yes
## 2 0.351 31 no
## 3 0.672 32 yes
## 4 0.167 21 no
## 5 2.288 33 yes
## 6 0.201 30 noSummary Statistics
skim(df)| Name | df |
| Number of rows | 768 |
| Number of columns | 9 |
| _______________________ | |
| Column type frequency: | |
| factor | 1 |
| numeric | 8 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Outcome | 0 | 1 | FALSE | 2 | no: 500, yes: 268 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Pregnancies | 111 | 0.86 | 4.49 | 3.22 | 1.00 | 2.00 | 4.00 | 7.00 | 17.00 | ▇▃▂▁▁ |
| Glucose | 5 | 0.99 | 121.69 | 30.54 | 44.00 | 99.00 | 117.00 | 141.00 | 199.00 | ▁▇▇▃▂ |
| BloodPressure | 35 | 0.95 | 72.41 | 12.38 | 24.00 | 64.00 | 72.00 | 80.00 | 122.00 | ▁▃▇▂▁ |
| SkinThickness | 227 | 0.70 | 29.15 | 10.48 | 7.00 | 22.00 | 29.00 | 36.00 | 99.00 | ▆▇▁▁▁ |
| Insulin | 374 | 0.51 | 155.55 | 118.78 | 14.00 | 76.25 | 125.00 | 190.00 | 846.00 | ▇▂▁▁▁ |
| BMI | 11 | 0.99 | 32.46 | 6.92 | 18.20 | 27.50 | 32.30 | 36.60 | 67.10 | ▅▇▃▁▁ |
| DiabetesPedigreeFunction | 0 | 1.00 | 0.47 | 0.33 | 0.08 | 0.24 | 0.37 | 0.63 | 2.42 | ▇▃▁▁▁ |
| Age | 0 | 1.00 | 33.24 | 11.76 | 21.00 | 24.00 | 29.00 | 41.00 | 81.00 | ▇▃▁▁▁ |
Berdasarkan output di atas, terdapat 763 missing value dalam data yang tersebar di 6 variabel. Variabel tersebut ialah Pregnancies, Glucose, BloodPressure, SkinThickness, Insulin, dan BMIdengan jumlah missing value pada tiap variabel 111, 5, 35, 227, 374, dan 11. Dapat diketahui pula rata-rata, standar deviasi, dan sebaran data melalui histogram untuk setiap variabel.
Visualisasi Data
Diketahui semua variabel independen yang ada pada data bersifat numeric sehingga akan dilakukan visualisasi menggunakan Histogram dan Boxplot.
Pregnancies
par(mfrow=c(1,2)) hist(df$Pregnancies, main="Histogram for Pregnancies", xlab="Pregnancies", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$Pregnancies, col='yellow',xlab = 'Pregnancies', main = 'Boxplot for Pregnancies', outcol="red", pch=16)
Glucose
par(mfrow=c(1,2)) hist(df$Glucose, main="Histogram for Glucose", xlab="Glucose", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$Glucose, col='yellow',xlab = 'Glucose', main = 'Boxplot for Glucose', outcol="red", pch=16)
Blood Pressure
par(mfrow=c(1,2)) hist(df$BloodPressure, main="Histogram for Blood Pressure", xlab="Blood Pressure", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$BloodPressure, col='yellow',xlab = 'BloodPressure', main = 'Boxplot for Blood Pressure', outcol = "red", pch = 16)
Skin Thickness
par(mfrow=c(1,2)) hist(df$SkinThickness, main="Histogram for Skin Thickness", xlab="Skin Thickness", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$SkinThickness, col='yellow',xlab = 'SkinThickness', main = 'Boxplot for Skin Thickness', outcol = "red", pch = 16)
Insulin
par(mfrow=c(1,2)) hist(df$Insulin, main="Histogram for Insulin", xlab="Insulin", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$Insulin, col='yellow',xlab = 'Insulin', main = 'Boxplot for Insulin', outcol = "red", pch = 16)
BMI
par(mfrow=c(1,2)) hist(df$BMI, main="Histogram for BMI", xlab="BMI", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$BMI, col='yellow',xlab = 'BMI', main = 'Boxplot for BMI', outcol = "red", pch = 16)
Diabetes Pedigree Function
par(mfrow=c(1,2)) hist(df$DiabetesPedigreeFunction, main="Histogram for Diabetes Pedigree Function", xlab="Diabetes Pedigree Function", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$DiabetesPedigreeFunction, col='yellow',xlab = 'Diabetes Pedigree Function', main = 'Boxplot for Diabetes Pedigree Function', outcol = "red", pch = 16)
Age
par(mfrow=c(1,2)) hist(df$Age, main="Histogram for Age", xlab="Age", border="black", col="yellow", las=1, breaks=20, prob = TRUE) boxplot(df$Age, col='yellow',xlab = 'Age', main = 'Boxplot for Age', outcol = "red", pch = 16)
Berdasarkan output Boxplot dari 8 variabel numeric di atas, diketahui bahwa 7 variabel memiliki outlier, hanya variabel Glucoseyang tidak memiliki outlier. Selain itu, dari output Histogram diketahui bahwa 7 variabel cenderung menceng kanan, yaitu Pregnancies, Glucose, SkinThickness, Insulin, BMI, DiabetesPedigreeFunction, dan Age. Sementara itu, dari histogram BloodPressure terlihat bahwa variabel tersebut memiliki sebaran yang cenderung simetris/normal.
Imbalance Data Check
Imbalance atau data tidak berimbang merupakan kondisi dimana salah satu atau lebih dari class yang ada dalam suatu himpunan memiliki jumlah yang cukup timpang atau memliki perbedaan yang cukup jauh diantara class yang ada.
plotImbalance<-function(data){
ggplot(data, aes(x = Outcome)) +
geom_bar(aes(fill = "blue")) +
ggtitle("Outcome") +
theme(legend.position="none")
}
plotImbalance(df)
#Imbalance Ratio
imbalanceRatio(df, classAttr = "Outcome")## [1] 0.536#Sebaran
table(df$Outcome)##
## no yes
## 500 268prop.table(table(df$Outcome))##
## no yes
## 0.6510417 0.3489583Berdasarkan output di atas, terlihat bahwa terjadi imbalance pada data yang digunakan, yaitu terdapat 65% untuk kelas mayoritas (Kategori No) dan 35% untuk kelas minoritas (Kategori Yes).
Imputation Missing Values
Cek Missing Value
sapply(df,function(x) sum(is.na(x)))## Pregnancies Glucose BloodPressure
## 111 5 35
## SkinThickness Insulin BMI
## 227 374 11
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Terlihat bahwa terdapat 111 Missing Value pada variabel Pregnancies, 5 Missing Value pada variabel Glucose, 35 Missing Value pada variabel BloodPressure, 227 Missing Value pada variabel SkinThickness, 374 Missing Value pada variabel Insulin, dan 11 Missing Value pada variabel BMI.
Imputasi dengan k-Nearest Neighbors
set.seed(125)
df1 = kNN(df, k=5, imp_var = FALSE)
sapply(df1,function(x) sum(is.na(x)))## Pregnancies Glucose BloodPressure
## 0 0 0
## SkinThickness Insulin BMI
## 0 0 0
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Terlihat bahwa Missing Value pada data tersebut sudah tidak ada.
Treat Extreme Values
Akan dilakukan transformasi pada variabel yang tidak berdistribusi normal menurut bentuk histogram yang telah dibuat pada bagian Visualisasi Data. Berikut merupakan variabel yang ditransformasi menggunakan logaritma.
- Pregnancies
df1$Pregnancies<-log(df1$Pregnancies)
hist(df1$Pregnancies,
main="Histogram for Pregnancies",
xlab="Pregnancies",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$Pregnancies), col='black', lwd=3)
- Skin Thickness
df1$SkinThickness<-log(df1$SkinThickness)
hist(df1$SkinThickness,
main="Histogram for Skin Thickness",
xlab="Skin Thickness",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$SkinThickness), col='black', lwd=3)
- Insulin
df1$Insulin<-log(df1$Insulin)
hist(df1$Insulin,
main="Histogram for Insulin",
xlab="Insulin",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$Insulin), col='black', lwd=3)
- BMI
df1$BMI<-log(df1$BMI)
hist(df1$BMI,
main="Histogram for BMI",
xlab="BMI",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$BMI), col='black', lwd=3)
- Diabetes Pedigree Function
df1$DiabetesPedigreeFunction<-log(df1$DiabetesPedigreeFunction)
hist(df1$DiabetesPedigreeFunction,
main="Histogram for Diabetes Pedigree Function",
xlab="Diabetes Pedigree Function",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$DiabetesPedigreeFunction), col='black', lwd=3)
- Age
df1$Age<-log(df1$Age)
hist(df1$Age,
main="Histogram for Age",
xlab="Age",
border="black",
col="yellow",
las=1,
breaks=20, prob = TRUE)
lines(density(df1$Age), col='black', lwd=3)
Analisis Korelasi
cordata <- data.matrix(df1)
cormat <- round(cor(cordata, method = "pearson"),2)
melted_cormat <- melt(cormat)
# Peroleh segitiga atas dari matriks korelasi
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
upper_tri <- get_upper_tri(cormat)
# Atur matriks korelasi
melted_cormat <- melt(upper_tri, na.rm = TRUE)
# Buat ggheatmap
ggheatmap <- ggplot(melted_cormat, aes(Var2, Var1, fill = value))+
geom_tile(color = "white")+
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1), space = "Lab",
name="Pearson\nCorrelation") +
theme_minimal()+ # minimal theme
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 9, hjust = 1))+
coord_fixed()
ggheatmap +
geom_text(aes(Var2, Var1, label = value), color = "black", size = 2) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
legend.justification = c(1, 0),
legend.position = c(0.6, 0.7),
legend.direction = "horizontal")+
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))
Berdasarkan output di atas, terluhat bahwa variabel Glucose memiliki korelasi terbesar dengan variabel target (Outcome), yaitu sebesar 0.49.
Data Preparation
Treat Imbalance Data
Berikut ini akan dilakukan perbandingan terhadap beberapa algoritma resampling untuk menyeimbangkan distribusi data.
Synthetic Minority Over-sampling Technique (SMOTE)
dataSMOTE <- smote(Outcome ~ ., df1, perc.over = 2, perc.under = 2)
plotImbalance(dataSMOTE)
imbalanceRatio(dataSMOTE, classAttr = "Outcome")## [1] 0.75#Sebaran
table(dataSMOTE$Outcome)##
## no yes
## 1072 804prop.table(table(dataSMOTE$Outcome))##
## no yes
## 0.5714286 0.4285714Adaptive Synthetic (ADASYN)
set.seed(123)
dataADASYN <- oversample(df1, method = "ADASYN", classAttr = "Outcome")
plotImbalance(dataADASYN)
imbalanceRatio(dataADASYN, classAttr = "Outcome")## [1] 0.934#Sebaran
table(dataADASYN$Outcome)##
## no yes
## 500 467prop.table(table(dataADASYN$Outcome))##
## no yes
## 0.5170631 0.4829369Majority-Weighted Minority Over-sampling Technique (MWMOTE)
set.seed(123)
dataMWMOTE <- oversample(df1, ratio = 0.934, method = "MWMOTE", classAttr = "Outcome")
plotImbalance(dataMWMOTE)
imbalanceRatio(dataMWMOTE, classAttr = "Outcome")## [1] 0.934#Sebaran
table(dataMWMOTE$Outcome)##
## no yes
## 500 467prop.table(table(dataMWMOTE$Outcome))##
## no yes
## 0.5170631 0.4829369Berdasarkan hasil pengecekan imbalance ratio di atas, dipilih hasil dari MWMOTE karena memberikan nilai imbalance ratio yang lebih besar dan tidak mengubah posisi kelas mayoritas (Kategori No).
dataset = dataMWMOTEModelling
Setelah dilakukan preprocessing pada dataset, tahap selanjutnya adalah Modelling. Dalam melakukan pemodelan Random Forest, dataset perlu dipisah menjadi data training dan data testing. Metode k-Fold Cross Validation digunakan untuk menghindari overlapping pada data testing.
k-Fold Cross Validation
# Set seed untuk menghasilkan keacakan yang sama
set.seed(123)
# Tentukan cross validation berulang dengan 10 folds/lipatan dan satu pengulangan
evaluationSetting <- trainControl(method='repeatedcv',
number=10,
repeats=1,
# Evaluate performance using
# the following function summaryFunction
summaryFunction = multiClassSummary,
savePredictions = TRUE)Random Forest
rf_model <- train(factor(Outcome)~.,
data=dataset,
method="rf",
metric="Accuracy",
parms = list(split='information'),
tuneLength = 7,
trControl=evaluationSetting)Evaluation
Summary Model Performances
print(rf_model)## Random Forest
##
## 967 samples
## 8 predictor
## 2 classes: 'no', 'yes'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 1 times)
## Summary of sample sizes: 870, 870, 870, 871, 871, 870, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa F1 Sensitivity Specificity
## 2 0.8603522 0.7209865 0.8602382 0.836 0.8863090
## 3 0.8613939 0.7229725 0.8620522 0.842 0.8820537
## 4 0.8613939 0.7231503 0.8605123 0.834 0.8905643
## 5 0.8644759 0.7292767 0.8640104 0.840 0.8905643
## 6 0.8644974 0.7293426 0.8638149 0.838 0.8927382
## 7 0.8593106 0.7189363 0.8590820 0.836 0.8841813
## 8 0.8593320 0.7189752 0.8591197 0.836 0.8842276
## Pos_Pred_Value Neg_Pred_Value Precision Recall Detection_Rate
## 0.8872895 0.8365548 0.8872895 0.836 0.4322809
## 0.8840865 0.8408630 0.8840865 0.842 0.4353845
## 0.8907661 0.8364321 0.8907661 0.834 0.4312607
## 0.8913302 0.8417553 0.8913302 0.840 0.4343428
## 0.8931172 0.8401603 0.8931172 0.838 0.4333226
## 0.8850657 0.8370805 0.8850657 0.836 0.4322702
## 0.8850361 0.8370186 0.8850361 0.836 0.4322809
## Balanced_Accuracy
## 0.8611545
## 0.8620268
## 0.8622821
## 0.8652821
## 0.8653691
## 0.8600907
## 0.8601138
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 6.plot(rf_model)
Final Model
Berikut merupakan final model dari proses modelling dengan Random Forest yang telah dilakukan.
rf_model$finalModel##
## Call:
## randomForest(x = x, y = y, mtry = min(param$mtry, ncol(x)), parms = ..1)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 6
##
## OOB estimate of error rate: 13.24%
## Confusion matrix:
## no yes class.error
## no 421 79 0.1580000
## yes 49 418 0.1049251