Library
library(ISLR)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(xgboost)
library(UBL)
## Loading required package: MBA
## Loading required package: gstat
## Loading required package: automap
## Loading required package: sp
## Loading required package: randomForest
## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
## The following object is masked from 'package:ggplot2':
##
## margin
library(pROC)
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
library(ggplot2)
library(e1071)
Data
Data yang digunakan pada penelitian ini adalah data kondisi kesehatan
768 wanita suku Indian Pima usia 21 tahun ke atas. Data ini merupakan
data sekunder yang diperoleh dari laman Kaggle. Rincian peubah respon
dan peubah penjelas yang digunakan tertera tabel dibawah ini :
| Peubah | Keterangan | Satuan | Sumber Pustaka |
|---|---|---|---|
| Y | Diabetes melitus | 0 atau 1 | |
| X1 | Jumlah kehamilan | Yanti dan Surtiningsih (2016) | |
| X2 | Kadar glukosa | mg/dL | Perkeni (2021) |
| X3 | Tekanan darah | mm Hg | Ekasari et al. (2021) |
| X4 | Ketebalan trisep | mm | Collier et al. (1989) |
| X5 | Insulin | μU/mL | Wilcox (2005) |
| X6 | IMT | kg/m2 | Adnan et al. (2013) |
| X7 | Diabetes Pedigree Function | Joshi et al. (2021) | |
| X8 | Usia | Tahun | Yan et al. (2023) |
dt.tpm <- read.csv("diabetes.csv")
dt.tpm$outcome <- as.factor(dt.tpm$outcome)
Eksplorasi Data dan Pre-processing
head(dt.tpm)
## pregnancies glucose bloodpressure skinthickness insulin bmi
## 1 6 148 72 35 0 33.6
## 2 1 85 66 29 0 26.6
## 3 8 183 64 0 0 23.3
## 4 1 89 66 23 94 28.1
## 5 0 137 40 35 168 43.1
## 6 5 116 74 0 0 25.6
## diabetespedigreefunction age outcome
## 1 0.627 50 true
## 2 0.351 31 false
## 3 0.672 32 true
## 4 0.167 21 false
## 5 2.288 33 true
## 6 0.201 30 false
Terdapat peubah yang bernilai 0 padahal tidak mungkin peubah tersebut nilainya 0
skimr::skim(dt.tpm)
| Name | dt.tpm |
| 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 | fal: 500, tru: 268 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| pregnancies | 0 | 1 | 3.85 | 3.37 | 0.00 | 1.00 | 3.00 | 6.00 | 17.00 | ▇▃▂▁▁ |
| glucose | 0 | 1 | 120.89 | 31.97 | 0.00 | 99.00 | 117.00 | 140.25 | 199.00 | ▁▁▇▆▂ |
| bloodpressure | 0 | 1 | 69.11 | 19.36 | 0.00 | 62.00 | 72.00 | 80.00 | 122.00 | ▁▁▇▇▁ |
| skinthickness | 0 | 1 | 20.54 | 15.95 | 0.00 | 0.00 | 23.00 | 32.00 | 99.00 | ▇▇▂▁▁ |
| insulin | 0 | 1 | 79.80 | 115.24 | 0.00 | 0.00 | 30.50 | 127.25 | 846.00 | ▇▁▁▁▁ |
| bmi | 0 | 1 | 31.99 | 7.88 | 0.00 | 27.30 | 32.00 | 36.60 | 67.10 | ▁▃▇▂▁ |
| diabetespedigreefunction | 0 | 1 | 0.47 | 0.33 | 0.08 | 0.24 | 0.37 | 0.63 | 2.42 | ▇▃▁▁▁ |
| age | 0 | 1 | 33.24 | 11.76 | 21.00 | 24.00 | 29.00 | 41.00 | 81.00 | ▇▃▁▁▁ |
pada data tidak terlihat adanya missing value namun pada eksplorasi awal terdapat beberapa peubah bernilai 0 padahal seharusnya tidak mungkin peubah tersebut bernilai 0 sehingga hal ini mengindikasikan adanya missing value sehingga nilai 0 akan diganti dengan NaN
cols_to_replace <- c('glucose', 'bloodpressure', 'skinthickness', 'insulin', 'bmi')
dt.tpm[cols_to_replace] <- lapply(dt.tpm[cols_to_replace], function(x) ifelse(x == 0, NA, x))
head(dt.tpm)
## 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 0 137 40 35 168 43.1
## 6 5 116 74 NA NA 25.6
## diabetespedigreefunction age outcome
## 1 0.627 50 true
## 2 0.351 31 false
## 3 0.672 32 true
## 4 0.167 21 false
## 5 2.288 33 true
## 6 0.201 30 false
Pada data yang hilang akan dilakukan imputasi menggunakan nilai median dari peubah tersebut
dt.tpm[cols_to_replace] <- lapply(dt.tpm[cols_to_replace], function(x) {
x[is.na(x)] <- median(x, na.rm = TRUE)
return(x)
})
head(dt.tpm)
## pregnancies glucose bloodpressure skinthickness insulin bmi
## 1 6 148 72 35 125 33.6
## 2 1 85 66 29 125 26.6
## 3 8 183 64 29 125 23.3
## 4 1 89 66 23 94 28.1
## 5 0 137 40 35 168 43.1
## 6 5 116 74 29 125 25.6
## diabetespedigreefunction age outcome
## 1 0.627 50 true
## 2 0.351 31 false
## 3 0.672 32 true
## 4 0.167 21 false
## 5 2.288 33 true
## 6 0.201 30 false
Satuan dari setiap peubah berbeda - beda, oleh karena itu Selanjutnya akan dilakukan proses standarisasi data
# Memilih kolom-kolom numerik yang akan distandarisasi
numeric_columns <- sapply(dt.tpm, is.numeric)
selected_data <- dt.tpm[, numeric_columns]
# Standarisasi data
scaled_data <- scale(selected_data)
# Gantikan kolom numerik pada data awal dengan data yang sudah distandarisasi
dt.tpm[, numeric_columns] <- scaled_data
head(dt.tpm)
## pregnancies glucose bloodpressure skinthickness insulin bmi
## 1 0.6395305 0.8654807 -0.0319691 0.67020577 -0.1814230 0.1665109
## 2 -0.8443348 -1.2042810 -0.5279745 -0.01229328 -0.1814230 -0.8516448
## 3 1.2330766 2.0153484 -0.6933097 -0.01229328 -0.1814230 -1.3316324
## 4 -0.8443348 -1.0728676 -0.5279745 -0.69479233 -0.5402897 -0.6334686
## 5 -1.1411079 0.5040938 -2.6773314 0.67020577 0.3163598 1.5482935
## 6 0.3427574 -0.1858268 0.1333660 -0.01229328 -0.1814230 -0.9970956
## diabetespedigreefunction age outcome
## 1 0.4681869 1.42506672 true
## 2 -0.3648230 -0.19054773 false
## 3 0.6040037 -0.10551539 true
## 4 -0.9201630 -1.04087112 false
## 5 5.4813370 -0.02048305 true
## 6 -0.8175458 -0.27558007 false
table_diabet <- table(dt.tpm$outcome)
df_diabet <- as.data.frame(table_diabet)
bar.ploty <- ggplot(df_diabet, aes(x = Var1, y = Freq, fill = Var1)) +
geom_bar(stat = "identity", color = "white") +
geom_text(aes(label = Freq), vjust = -0.5, size = 3) +
theme_minimal() +
labs(title = "Bar Plot of Outcome Diabetes", x = "Outcome Diabetes", y = "Total") +
theme(axis.text.x = element_text(angle = 360, hjust = 1))
bar.ploty
Terlihat bahwa class data tidak seimbang sehingga nanti akan dilakukan penanganan data tidak seimbang pada data latih (train)
Splitting Data
set.seed(123)
train_idx <- createDataPartition(dt.tpm$outcome, p = 0.8, list=FALSE)
train.data <- dt.tpm[train_idx,]
test.data <- dt.tpm[-train_idx,]
Penanganan Imbalance Data
Imbalance data akan ditangani dengan Synthetic Minority Over-sampling Technique (SMOTE). SMOTE adalah metode untuk mengatasi masalah data tidak seimbang dalam machine learning. Ketika satu kelas memiliki jauh lebih sedikit contoh dibandingkan kelas lain, model cenderung mengabaikan kelas minoritas. SMOTE meningkatkan jumlah contoh kelas minoritas dengan membuat data sintetis. Teknik ini bekerja dengan mengidentifikasi contoh dari kelas minoritas, memilih tetangga terdekat, dan membuat contoh baru dengan menginterpolasi antara contoh asli dan tetangganya. Dengan demikian, SMOTE membantu menciptakan dataset yang lebih seimbang dan meningkatkan kemampuan model untuk mengenali kelas minoritas.
smote_data <- SmoteClassif(form = outcome ~ .,
dat = train.data,
C.perc = "balance",
dist = "HVDM")
# Melihat distribusi kelas setelah SMOTE
table(smote_data$outcome)
##
## false true
## 308 307
SVM
Support vector machine (SVM) merupakan salah satu teknik pembelajaran mesin yang digunakan untuk analisis prediksi, baik dalam bentuk klasifikasi maupun regresi. SVM pada dasarnya berprinsip linear classifier, yaitu teknik klasifikasi untuk data yang dapat dipisahkan secara linear (Santosa 2007). Namun, kini SVM telah dikembangkan sehingga juga mampu menyelesaikan permasalahan klasifikasi untuk data yang tidak linear dengan menerapkan konsep kernel pada ruang kerja berdimensi tinggi. SVM dilakukan dengan mencari hyperplane (bidang pembatas) yang memaksimalkan jarak antar kelas (Octaviani et al. 2014). Penggunaan kernel bertujuan untuk mentransformasikan data ke ruang berdimensi tinggi,dengan menjadikan data non linear terpisah secara linear.
SVM Dengan Kernel Linear
SVM dengan kernel linear adalah versi sederhana dari SVM yang menggunakan fungsi linear untuk memisahkan kelas-kelas dalam data. Kernel linear berarti bahwa keputusan yang diambil oleh SVM adalah berdasarkan garis lurus (untuk data dua dimensi), atau hyperplane (untuk data dengan lebih banyak dimensi), yang memisahkan kelas-kelas dalam ruang fitur.
# 10 fold cross validation
ctr <- trainControl(method='repeatedcv',
number=10,
repeats=3)
# Recall as C increases, the margin tends to get wider
grid <- data.frame(C=seq(0.01,10,0.5))
svm.linear <- train(outcome ~., smote_data,
method='svmLinear',
preProc=c('center','scale'),
trControl=ctr,
tuneGrid=grid)
svm.linear
## Support Vector Machines with Linear Kernel
##
## 615 samples
## 8 predictor
## 2 classes: 'false', 'true'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 554, 554, 553, 554, 554, 554, ...
## Resampling results across tuning parameters:
##
## C Accuracy Kappa
## 0.01 0.7366878 0.4733831
## 0.51 0.7420642 0.4841768
## 1.01 0.7414910 0.4830169
## 1.51 0.7409354 0.4819058
## 2.01 0.7403978 0.4808305
## 2.51 0.7398602 0.4797552
## 3.01 0.7398602 0.4797552
## 3.51 0.7387761 0.4775944
## 4.01 0.7387761 0.4775944
## 4.51 0.7393225 0.4786800
## 5.01 0.7387761 0.4775944
## 5.51 0.7393225 0.4786800
## 6.01 0.7387761 0.4775944
## 6.51 0.7393225 0.4786800
## 7.01 0.7393225 0.4786800
## 7.51 0.7393225 0.4786800
## 8.01 0.7387761 0.4775944
## 8.51 0.7387761 0.4775944
## 9.01 0.7387761 0.4775944
## 9.51 0.7393225 0.4786800
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was C = 0.51.
svm.linear$bestTune
## C
## 2 0.51
ggplot(svm.linear)
# Training error rate
confusionMatrix(predict(svm.linear, smote_data), smote_data$outcome)
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 242 83
## true 66 224
##
## Accuracy : 0.7577
## 95% CI : (0.7219, 0.7911)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.5154
##
## Mcnemar's Test P-Value : 0.1899
##
## Sensitivity : 0.7857
## Specificity : 0.7296
## Pos Pred Value : 0.7446
## Neg Pred Value : 0.7724
## Prevalence : 0.5008
## Detection Rate : 0.3935
## Detection Prevalence : 0.5285
## Balanced Accuracy : 0.7577
##
## 'Positive' Class : false
##
# Testing error rate
yhat_1 <- predict(svm.linear, test.data)
svm.lin.acc <- confusionMatrix(yhat_1, test.data$outcome)
svm.lin.acc
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 83 13
## true 17 40
##
## Accuracy : 0.8039
## 95% CI : (0.7321, 0.8636)
## No Information Rate : 0.6536
## P-Value [Acc > NIR] : 3.3e-05
##
## Kappa : 0.5745
##
## Mcnemar's Test P-Value : 0.5839
##
## Sensitivity : 0.8300
## Specificity : 0.7547
## Pos Pred Value : 0.8646
## Neg Pred Value : 0.7018
## Prevalence : 0.6536
## Detection Rate : 0.5425
## Detection Prevalence : 0.6275
## Balanced Accuracy : 0.7924
##
## 'Positive' Class : false
##
Dengan menggunakan metode SVM dengan kernel linear diperoleh nilai akurasi sebesar 0.8039
SVM dengan Kernel Polinomial
SVM dengan kernel polinomial adalah variasi dari algoritma SVM yang menggunakan fungsi kernel polinomial untuk memetakan data ke ruang fitur yang lebih tinggi. Kernel polinomial memungkinkan SVM untuk menangani masalah klasifikasi yang tidak dapat dipisahkan secara linear dengan menambahkan fleksibilitas dalam pemisahan data. Kernel polinomial adalah fungsi kernel yang mendefinisikan kesamaan antara dua contoh data dalam ruang fitur yang lebih tinggi yang dibentuk oleh kombinasi polinomial dari fitur asli.
set.seed(123)
svm.poly <- train(outcome ~., smote_data,
method='svmPoly',
trControl=ctr,
tuneLength=4)
svm.poly
## Support Vector Machines with Polynomial Kernel
##
## 615 samples
## 8 predictor
## 2 classes: 'false', 'true'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 553, 553, 553, 553, 554, 555, ...
## Resampling results across tuning parameters:
##
## degree scale C Accuracy Kappa
## 1 0.001 0.25 0.5423497 0.08582243
## 1 0.001 0.50 0.6446674 0.28968987
## 1 0.001 1.00 0.7042088 0.40824621
## 1 0.001 2.00 0.7128362 0.42555704
## 1 0.010 0.25 0.7171729 0.43424853
## 1 0.010 0.50 0.7263840 0.45264080
## 1 0.010 1.00 0.7306936 0.46130520
## 1 0.010 2.00 0.7382916 0.47652223
## 1 0.100 0.25 0.7366875 0.47331843
## 1 0.100 0.50 0.7371981 0.47435583
## 1 0.100 1.00 0.7388207 0.47759423
## 1 0.100 2.00 0.7393760 0.47869015
## 1 1.000 0.25 0.7398869 0.47967908
## 1 1.000 0.50 0.7393581 0.47865067
## 1 1.000 1.00 0.7382828 0.47650014
## 1 1.000 2.00 0.7393581 0.47865067
## 2 0.001 0.25 0.6446674 0.28968987
## 2 0.001 0.50 0.7042088 0.40824621
## 2 0.001 1.00 0.7128362 0.42555704
## 2 0.001 2.00 0.7246997 0.44927168
## 2 0.010 0.25 0.7258373 0.45155641
## 2 0.010 0.50 0.7334085 0.46672758
## 2 0.010 1.00 0.7377540 0.47545395
## 2 0.010 2.00 0.7393760 0.47868901
## 2 0.100 0.25 0.7366893 0.47339018
## 2 0.100 0.50 0.7438119 0.48769928
## 2 0.100 1.00 0.7508367 0.50171064
## 2 0.100 2.00 0.7486859 0.49740713
## 2 1.000 0.25 0.7557104 0.51136329
## 2 1.000 0.50 0.7567945 0.51354774
## 2 1.000 1.00 0.7584697 0.51689498
## 2 1.000 2.00 0.7589806 0.51792760
## 3 0.001 0.25 0.6982866 0.39652283
## 3 0.001 0.50 0.7145208 0.42889673
## 3 0.001 1.00 0.7225404 0.44495691
## 3 0.001 2.00 0.7301475 0.46016759
## 3 0.010 0.25 0.7333730 0.46661672
## 3 0.010 0.50 0.7382919 0.47650343
## 3 0.010 1.00 0.7464363 0.49280961
## 3 0.010 2.00 0.7388295 0.47761164
## 3 0.100 0.25 0.7600026 0.51995992
## 3 0.100 0.50 0.7708167 0.54155834
## 3 0.100 1.00 0.7620715 0.52410020
## 3 0.100 2.00 0.7713006 0.54253830
## 3 1.000 0.25 0.7382381 0.47635586
## 3 1.000 0.50 0.7284185 0.45669217
## 3 1.000 1.00 0.7186706 0.43724221
## 3 1.000 2.00 0.7126582 0.42520953
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were degree = 3, scale = 0.1 and C = 2.
svm.poly$bestTune
## degree scale C
## 44 3 0.1 2
plot(svm.poly)
# Training error rate
confusionMatrix(predict(svm.poly, smote_data), smote_data$outcome)
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 260 39
## true 48 268
##
## Accuracy : 0.8585
## 95% CI : (0.8285, 0.8851)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.7171
##
## Mcnemar's Test P-Value : 0.3911
##
## Sensitivity : 0.8442
## Specificity : 0.8730
## Pos Pred Value : 0.8696
## Neg Pred Value : 0.8481
## Prevalence : 0.5008
## Detection Rate : 0.4228
## Detection Prevalence : 0.4862
## Balanced Accuracy : 0.8586
##
## 'Positive' Class : false
##
# Testing error rate
yhat_2 <- predict(svm.poly, test.data)
svm.poli.acc <- confusionMatrix(yhat_2, test.data$outcome)
svm.poli.acc
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 77 16
## true 23 37
##
## Accuracy : 0.7451
## 95% CI : (0.6684, 0.812)
## No Information Rate : 0.6536
## P-Value [Acc > NIR] : 0.009661
##
## Kappa : 0.454
##
## Mcnemar's Test P-Value : 0.336668
##
## Sensitivity : 0.7700
## Specificity : 0.6981
## Pos Pred Value : 0.8280
## Neg Pred Value : 0.6167
## Prevalence : 0.6536
## Detection Rate : 0.5033
## Detection Prevalence : 0.6078
## Balanced Accuracy : 0.7341
##
## 'Positive' Class : false
##
Dengan menggunakan metode SVM dengan kernel polinomial diperoleh nilai akurasi sebesar 0.7451
SVM dengan Kernel Radial
SVM dengan kernel radial basis function (RBF), juga dikenal sebagai kernel Gaussian, adalah varian dari SVM yang menggunakan fungsi kernel RBF untuk memetakan data ke ruang fitur yang lebih tinggi. Kernel RBF sangat populer karena kemampuannya untuk menangani dataset yang tidak dapat dipisahkan secara linear dengan lebih baik. Kernel RBF adalah fungsi yang mengukur kesamaan antara dua contoh data dalam ruang fitur yang lebih tinggi, menggunakan jarak Euclidean antara dua vektor.
set.seed(123)
svm.radial <- train(outcome ~., smote_data,
method='svmRadial',
trControl=ctr,
tuneLength=10)
svm.radial
## Support Vector Machines with Radial Basis Function Kernel
##
## 615 samples
## 8 predictor
## 2 classes: 'false', 'true'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 553, 553, 553, 553, 554, 555, ...
## Resampling results across tuning parameters:
##
## C Accuracy Kappa
## 0.25 0.7587667 0.5177016
## 0.50 0.7707809 0.5416386
## 1.00 0.7653605 0.5307793
## 2.00 0.7794985 0.5589329
## 4.00 0.7761840 0.5522352
## 8.00 0.7745805 0.5490668
## 16.00 0.7626194 0.5251263
## 32.00 0.7528888 0.5056945
## 64.00 0.7419660 0.4838423
## 128.00 0.7500664 0.5000264
##
## Tuning parameter 'sigma' was held constant at a value of 0.1282285
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were sigma = 0.1282285 and C = 2.
svm.radial$bestTune
## sigma C
## 4 0.1282285 2
plot(svm.radial)
# Training error rate
confusionMatrix(predict(svm.radial, smote_data), smote_data$outcome)
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 265 40
## true 43 267
##
## Accuracy : 0.865
## 95% CI : (0.8355, 0.8911)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.7301
##
## Mcnemar's Test P-Value : 0.8262
##
## Sensitivity : 0.8604
## Specificity : 0.8697
## Pos Pred Value : 0.8689
## Neg Pred Value : 0.8613
## Prevalence : 0.5008
## Detection Rate : 0.4309
## Detection Prevalence : 0.4959
## Balanced Accuracy : 0.8650
##
## 'Positive' Class : false
##
# Testing error rate
yhat_3 <- predict(svm.radial, test.data)
svm.rad.acc <- confusionMatrix(yhat_3, test.data$outcome)
svm.rad.acc
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 80 13
## true 20 40
##
## Accuracy : 0.7843
## 95% CI : (0.7106, 0.8466)
## No Information Rate : 0.6536
## P-Value [Acc > NIR] : 0.0003018
##
## Kappa : 0.538
##
## Mcnemar's Test P-Value : 0.2962699
##
## Sensitivity : 0.8000
## Specificity : 0.7547
## Pos Pred Value : 0.8602
## Neg Pred Value : 0.6667
## Prevalence : 0.6536
## Detection Rate : 0.5229
## Detection Prevalence : 0.6078
## Balanced Accuracy : 0.7774
##
## 'Positive' Class : false
##
Dengan menggunakan metode SVM dengan kernel radial diperoleh nilai akurasi sebesar 0.7843
XGBoost
XGBoost adalah algoritma yang berbasis pada metode boosting, di mana beberapa model prediksi (biasanya pohon keputusan) digabungkan untuk membentuk model yang lebih kuat. Setiap model baru mencoba untuk memperbaiki kesalahan dari model sebelumnya dengan menambahkan bobot lebih pada kesalahan prediksi.
set.seed(123)
# Definisikan kontrol untuk 10-fold cross-validation yang diulang 3 kali
ctr <- trainControl(method = 'repeatedcv',
number = 10,
repeats = 3,
verboseIter = TRUE)
# Definisikan grid parameter untuk tuning
grid <- expand.grid(
nrounds = 500, # Jumlah boosting rounds
max_depth = 10, # Kedalaman maksimum setiap pohon
eta = 0.1, # Learning rate
gamma = 5, # Minimum loss reduction
colsample_bytree = 0.7, # Proporsi fitur yang diambil secara acak
min_child_weight = 1, # Minimum sum of instance weight (hessian) needed in a child
subsample = 0.7 # Proporsi data yang diambil secara acak untuk setiap pohon
)
set.seed(123)
# Melatih model menggunakan XGBoost
xgb_model <- train(outcome ~ ., data = smote_data,
method = 'xgbTree',
trControl = ctr,
tuneGrid = grid,
preProcess = c('center', 'scale'))
## + Fold01.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold01.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold02.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold02.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold03.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold03.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold04.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold04.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold05.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold05.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold06.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold06.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold07.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold07.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold08.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold08.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold09.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold09.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold10.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold10.Rep1: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold01.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold01.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold02.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold02.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold03.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold03.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold04.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold04.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold05.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold05.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold06.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold06.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold07.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold07.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold08.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold08.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold09.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold09.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold10.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold10.Rep2: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold01.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold01.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold02.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold02.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold03.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold03.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold04.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold04.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold05.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold05.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold06.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold06.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold07.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold07.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold08.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold08.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold09.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold09.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## + Fold10.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## - Fold10.Rep3: nrounds=500, max_depth=10, eta=0.1, gamma=5, colsample_bytree=0.7, min_child_weight=1, subsample=0.7
## Aggregating results
## Fitting final model on full training set
xgb_model
## eXtreme Gradient Boosting
##
## 615 samples
## 8 predictor
## 2 classes: 'false', 'true'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 553, 553, 553, 553, 554, 555, ...
## Resampling results:
##
## Accuracy Kappa
## 0.7588016 0.5176012
##
## Tuning parameter 'nrounds' was held constant at a value of 500
## Tuning
## parameter 'min_child_weight' was held constant at a value of 1
##
## Tuning parameter 'subsample' was held constant at a value of 0.7
yhat_4 <- predict(xgb_model, newdata = test.data)
xgb.acc <- confusionMatrix(yhat_4, test.data$outcome)
xgb.acc
## Confusion Matrix and Statistics
##
## Reference
## Prediction false true
## false 85 8
## true 15 45
##
## Accuracy : 0.8497
## 95% CI : (0.783, 0.9023)
## No Information Rate : 0.6536
## P-Value [Acc > NIR] : 4.462e-08
##
## Kappa : 0.678
##
## Mcnemar's Test P-Value : 0.2109
##
## Sensitivity : 0.8500
## Specificity : 0.8491
## Pos Pred Value : 0.9140
## Neg Pred Value : 0.7500
## Prevalence : 0.6536
## Detection Rate : 0.5556
## Detection Prevalence : 0.6078
## Balanced Accuracy : 0.8495
##
## 'Positive' Class : false
##
Dengan menggunakan metode XGBoost diperoleh nilai akurasi sebesar 0.8497
Evaluasi Model
Pada evaluasi model, metrik evaluasi yang digunakan adalah accuracy, presisi, recall dan F1 Score.
Akurasi (Accuracy), mengukur sejauh mana model secara keseluruhan dapat melakukan prediksi dengan benar.
Presisi (Precision), mengukur sejauh mana prediksi positif yang dibuat oleh model adalah benar.
Recall (juga dikenal sebagai Sensitivitas), mengukur sejauh mana model berhasil mendeteksi semua contoh positif yang sebenarnya.
F1-Score adalah ukuran gabungan dari presisi dan recall yang mencoba memberikan gambaran keseluruhan kinerja model.
# Fungsi untuk menghitung metrik evaluasi
calculate_metrics <- function(model, test.data) {
# Prediksi
predictions <- predict(model, test.data)
prob_predictions <- predict(model, test.data, type = "prob")
# Confusion Matrix
conf_matrix <- confusionMatrix(predictions, test.data$outcome)
# Accuracy
accuracy <- conf_matrix$overall['Accuracy']
# Precision, Recall, F1 Score
precision <- posPredValue(predictions, test.data$outcome)
recall <- sensitivity(predictions, test.data$outcome)
f1 <- F_meas(predictions, test.data$outcome)
return(list(accuracy = accuracy, precision = precision, recall = recall, f1 = f1, conf_matrix = conf_matrix))
}
# Menghitung metrik evaluasi untuk semua model
svm.lin.acc <- calculate_metrics(svm.linear, test.data)
## Warning in method$prob(modelFit = modelFit, newdata = newdata, submodels =
## param): kernlab class probability calculations failed; returning NAs
svm.poly.acc <- calculate_metrics(svm.poly, test.data)
## Warning in method$prob(modelFit = modelFit, newdata = newdata, submodels =
## param): kernlab class probability calculations failed; returning NAs
svm.rad.acc <- calculate_metrics(svm.radial, test.data)
## Warning in method$prob(modelFit = modelFit, newdata = newdata, submodels =
## param): kernlab class probability calculations failed; returning NAs
xgb.acc <- calculate_metrics(xgb_model, test.data)
eval_all <- matrix(
c(
svm.lin.acc$accuracy, svm.lin.acc$precision, svm.lin.acc$recall, svm.lin.acc$f1,
svm.poly.acc$accuracy, svm.poly.acc$precision, svm.poly.acc$recall, svm.poly.acc$f1,
svm.rad.acc$accuracy, svm.rad.acc$precision, svm.rad.acc$recall, svm.rad.acc$f1,
xgb.acc$accuracy, xgb.acc$precision, xgb.acc$recall, xgb.acc$f1
),
nrow = 4, byrow = TRUE
)
colnames(eval_all) <- c("Accuracy", "Precision", "Recall", "F1 Score")
row.names(eval_all) <- c("SVM Linear", "SVM Polynomial", "SVM Radial", "XGBoost")
eval_all <- as.data.frame(eval_all)
print(eval_all)
## Accuracy Precision Recall F1 Score
## SVM Linear 0.8039216 0.8645833 0.83 0.8469388
## SVM Polynomial 0.7450980 0.8279570 0.77 0.7979275
## SVM Radial 0.7843137 0.8602151 0.80 0.8290155
## XGBoost 0.8496732 0.9139785 0.85 0.8808290
Berdasarkan output diatas dapat dilihat bahwa model XGBoost merupakan model terbaik dibandingkan dengan SVM dengan accuracy sebesar 84.96%, presisi sebesar 91.39%, recall sebesar 85% dan F1 Score sebesar 88%.
Importance Variable
plot(varImp(xgb_model),
main = "XGBoost Variable Importance" )
Berdasarkan plot variable importance diatas dapat dilihat bahwa 3 peubah yang paling berpengaruh terhadap diabetes adalah kadar glukosa, indeks massa tubuh dan usia.