IPB University
Tugas Kuliah Sains Data Pertemuan 13
Ensamble tree (adaboost)
Salah satu fungsi yang dapat digunakan untuk menjalankan algoritma AdaBoost di R adalah boosting() yang tersedia pada package adabag.
Pada program di bawah ini digunakan iterasi sebanyak 500 kali. Artinya ada 500 stump/pohon kecil yang dibuat secara sekuensial yang diatur sedemikian rupa menggunakan opsi mfinal=500.
Opsi pohon yang digunakan adalah maxdepth=1 untuk meminta program membuat stump sebagai weak learner dari algoritma boosting. Pembaca dapat menghilangkan opsi tersebut jika ingin menggunakan pohon klasifikasi biasa sebagai weak lerner.
Algoritma dijalankan dan model yang diperoleh disimpan pada objek dengan nama model.adaboost . Model dibuat menggunakan data training yang sebelumnya diambil secara acak dari data lengkap.
Berikut adalah simulasi penggunaan model adaboost untuk mengklasifikasikan suatu negara berdasarkan jumlah hutangnya, yaitu high or low dari sudut pandang resiko jika berinvestasi di negara tsb. Dengan deskripsi masing-masing variabel X sebagai berikut :
| Variabel | Keterangan |
|---|---|
| X1 | capital adequacy ratio (%) average from last 5 years |
| X2 | GDP per capital (USD) |
| X3 | Gross External Debt (% of GDP) average from last 5 years |
| X4 | growth of consumer price (%) average from last 5 years |
| X5 | growth of population (%) average from last 5 years |
| X6 | growth of Real GDP (%) average from last 5 years |
| X7 | growth of Real GDP per cap. (%) average from last 5 years |
| X8 | Loan-deposit ratio (%) average from last 5 years |
| X9 | Net External Debt (% of GDP) average from last 5 years |
| X10 | Nominal GDP (USD bn) |
| X11 | Non-performing loans (% of gross loans) average from last 5 years |
| X12 | percentage of gross domestic investment to GDP (%) average from last 5 years |
| X13 | percentage of gross domestic saving to GDP (%) average from last 5 years |
| X14 | unemployment rate (% labour force) average from last 5 years |
Untuk membangun model klasifikasi tersebut, berikut ini adalah algoritma nya.
Algoritma :
Import Data
Cleaning Data
Splitting Data
Generate Model
Data Prediction
Model Evaluation
AdaBoost Simulasi 1 (rf)
Pada simulasi yang pertama ini, pendugaan data hilang nya menggunkan metode rf dari package MICE.
Import Data
Berikut adalah data yang akan digunakan dalam simulasi pemodelan klasifikasi adaboost kali ini.
#memasukkan data dari excel ke R
data <- read.csv2("D:/Magister IPB/Sains Data-STA581/Kuliah/UAS/Pertemuan 13/tugas STA581 - investment risk level.csv",stringsAsFactors = TRUE)
dim(data)## [1] 117 15#mengubah tipe data pada variabel respon Y menjadi factor
data$Y <- as.factor(data$Y)
head(data,10)Splitting Data
Sebelum membuat model, terlebih dahulu data kita split menjadi dua bagian yaitu data latih dan data uji sebagai berikut.
library(rpart)
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.1 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(mlr3verse)## Loading required package: mlr3library(mlr3extralearners)##
## Attaching package: 'mlr3extralearners'## The following objects are masked from 'package:mlr3':
##
## lrn, lrnslibrary(precrec)##
## Attaching package: 'precrec'## The following object is masked from 'package:pROC':
##
## auclibrary(adabag)## Loading required package: caret## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## lift## Loading required package: foreach##
## Attaching package: 'foreach'## The following objects are masked from 'package:purrr':
##
## accumulate, when## Loading required package: doParallel## Loading required package: iterators## Loading required package: parallellibrary(ROCR)
library(ROCit)
library(magrittr)##
## Attaching package: 'magrittr'## The following object is masked from 'package:purrr':
##
## set_names## The following object is masked from 'package:tidyr':
##
## extractlibrary(rpart.plot)
library(ada)
library(mice)##
## Attaching package: 'mice'## The following object is masked from 'package:stats':
##
## filter## The following objects are masked from 'package:base':
##
## cbind, rbindlibrary(visdat)
library(naniar)
library(UpSetR)##
## Attaching package: 'UpSetR'## The following object is masked from 'package:lattice':
##
## histogramlibrary(laeken)
library(vcd)## Loading required package: gridlibrary(VIM)## Loading required package: colorspace##
## Attaching package: 'colorspace'## The following object is masked from 'package:pROC':
##
## coords## 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(sm)## Package 'sm', version 2.2-5.7: type help(sm) for summary informationset.seed(1238)
index <- createDataPartition(data$Y, p = 0.8,list = FALSE)
#membagi data menjadi data train dan data test
train.dataindex <- data[index,]
dim(train.dataindex)## [1] 95 15test.dataindex <- data[-index,]
dim(test.dataindex)## [1] 22 15Data dipisahkan menjadi data trianing dan testing masing-masing 95 observasi dan 22 observasi. Data training selanjutnya akan digunakan sebagai pembangun model, sedangkan data testing sebagai penguji model.
Cleaning Data
Sebelum melakukan pembuatan model, terlebih dahulu perlu dilakukan beberapa pengecekan data diantaranya adakah imbalanced data dan missing value dari data yang kita miliki dengan cara sebagai berikut.
#Cek Data
str(train.dataindex)## 'data.frame': 95 obs. of 15 variables:
## $ X1 : num 17.5 18.2 18.7 NA 14 ...
## $ X2 : num 38675 40105 76038 27883 4251 ...
## $ X3 : num 172.8 103.5 31 24.8 89.6 ...
## $ X4 : num 0.68 1.77 2.63 1.29 1.44 ...
## $ X5 : num 1.221 0.87 1.489 1.753 0.256 ...
## $ X6 : num 1.79 2.66 1.85 2.23 4.75 ...
## $ X7 : num -2.084 -0.725 -1.901 -1.135 2.332 ...
## $ X8 : num 55 103 103 103 167 ...
## $ X9 : num -26.5 -13.6 -56.2 24.8 47.3 ...
## $ X10: num 2.86 352.91 199.93 10.11 12.65 ...
## $ X11: num 8 8.15 8.15 NA 6.6 ...
## $ X12: num 23.1 24.9 20.4 21.7 19.4 ...
## $ X13: num 26.9 32.5 31 17.3 15.1 ...
## $ X14: num 3 2.45 NA NA 18.5 ...
## $ Y : Factor w/ 2 levels "high","low": 2 2 2 2 1 1 1 2 2 1 ...table(train.dataindex$Y)##
## high low
## 52 43Dari tabel tersebut terlihat bahwa proporsi data kategori highdan low cukup seimbang, sehinngga tidak ada masalah imbalanced data pada dataset tersebut.
#Cek Missing values
anyNA(train.dataindex)## [1] TRUE#SUmmary Missing Values
miss_var_summary(train.dataindex)Dari hasil uji missing data di atas, terlihat bahwa pada data tersebut terdapat missing data yang perlu ditangani sebelum dilanjutkan ke tahap pembuatan model.
#Visualize the missing data
aggr_plot<- aggr(train.dataindex, col = c('navyblue', 'red'),
numbers = T,
sortVars = T,
labels=names(data),
cex.axis = .9,
gap = 3,
ylab = c( "Histogram of Missing Data", "Pattern")
)
##
## Variables sorted by number of missings:
## Variable Count
## X11 0.18947368
## X14 0.10526316
## X1 0.08421053
## X8 0.07368421
## X2 0.00000000
## X3 0.00000000
## X4 0.00000000
## X5 0.00000000
## X6 0.00000000
## X7 0.00000000
## X9 0.00000000
## X10 0.00000000
## X12 0.00000000
## X13 0.00000000
## Y 0.00000000Visualisasi di atas, membantu kita dalam melihat variabel yang terdapat missing data.
#Handling missing values dengan MICE Metode rf
my_imp<- mice(train.dataindex, m = 5, method = "rf", maxit = 20, seed = 52500)##
## iter imp variable
## 1 1 X1 X8 X11 X14
## 1 2 X1 X8 X11 X14
## 1 3 X1 X8 X11 X14
## 1 4 X1 X8 X11 X14
## 1 5 X1 X8 X11 X14
## 2 1 X1 X8 X11 X14
## 2 2 X1 X8 X11 X14
## 2 3 X1 X8 X11 X14
## 2 4 X1 X8 X11 X14
## 2 5 X1 X8 X11 X14
## 3 1 X1 X8 X11 X14
## 3 2 X1 X8 X11 X14
## 3 3 X1 X8 X11 X14
## 3 4 X1 X8 X11 X14
## 3 5 X1 X8 X11 X14
## 4 1 X1 X8 X11 X14
## 4 2 X1 X8 X11 X14
## 4 3 X1 X8 X11 X14
## 4 4 X1 X8 X11 X14
## 4 5 X1 X8 X11 X14
## 5 1 X1 X8 X11 X14
## 5 2 X1 X8 X11 X14
## 5 3 X1 X8 X11 X14
## 5 4 X1 X8 X11 X14
## 5 5 X1 X8 X11 X14
## 6 1 X1 X8 X11 X14
## 6 2 X1 X8 X11 X14
## 6 3 X1 X8 X11 X14
## 6 4 X1 X8 X11 X14
## 6 5 X1 X8 X11 X14
## 7 1 X1 X8 X11 X14
## 7 2 X1 X8 X11 X14
## 7 3 X1 X8 X11 X14
## 7 4 X1 X8 X11 X14
## 7 5 X1 X8 X11 X14
## 8 1 X1 X8 X11 X14
## 8 2 X1 X8 X11 X14
## 8 3 X1 X8 X11 X14
## 8 4 X1 X8 X11 X14
## 8 5 X1 X8 X11 X14
## 9 1 X1 X8 X11 X14
## 9 2 X1 X8 X11 X14
## 9 3 X1 X8 X11 X14
## 9 4 X1 X8 X11 X14
## 9 5 X1 X8 X11 X14
## 10 1 X1 X8 X11 X14
## 10 2 X1 X8 X11 X14
## 10 3 X1 X8 X11 X14
## 10 4 X1 X8 X11 X14
## 10 5 X1 X8 X11 X14
## 11 1 X1 X8 X11 X14
## 11 2 X1 X8 X11 X14
## 11 3 X1 X8 X11 X14
## 11 4 X1 X8 X11 X14
## 11 5 X1 X8 X11 X14
## 12 1 X1 X8 X11 X14
## 12 2 X1 X8 X11 X14
## 12 3 X1 X8 X11 X14
## 12 4 X1 X8 X11 X14
## 12 5 X1 X8 X11 X14
## 13 1 X1 X8 X11 X14
## 13 2 X1 X8 X11 X14
## 13 3 X1 X8 X11 X14
## 13 4 X1 X8 X11 X14
## 13 5 X1 X8 X11 X14
## 14 1 X1 X8 X11 X14
## 14 2 X1 X8 X11 X14
## 14 3 X1 X8 X11 X14
## 14 4 X1 X8 X11 X14
## 14 5 X1 X8 X11 X14
## 15 1 X1 X8 X11 X14
## 15 2 X1 X8 X11 X14
## 15 3 X1 X8 X11 X14
## 15 4 X1 X8 X11 X14
## 15 5 X1 X8 X11 X14
## 16 1 X1 X8 X11 X14
## 16 2 X1 X8 X11 X14
## 16 3 X1 X8 X11 X14
## 16 4 X1 X8 X11 X14
## 16 5 X1 X8 X11 X14
## 17 1 X1 X8 X11 X14
## 17 2 X1 X8 X11 X14
## 17 3 X1 X8 X11 X14
## 17 4 X1 X8 X11 X14
## 17 5 X1 X8 X11 X14
## 18 1 X1 X8 X11 X14
## 18 2 X1 X8 X11 X14
## 18 3 X1 X8 X11 X14
## 18 4 X1 X8 X11 X14
## 18 5 X1 X8 X11 X14
## 19 1 X1 X8 X11 X14
## 19 2 X1 X8 X11 X14
## 19 3 X1 X8 X11 X14
## 19 4 X1 X8 X11 X14
## 19 5 X1 X8 X11 X14
## 20 1 X1 X8 X11 X14
## 20 2 X1 X8 X11 X14
## 20 3 X1 X8 X11 X14
## 20 4 X1 X8 X11 X14
## 20 5 X1 X8 X11 X14summary(my_imp)## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## "rf" "" "" "" "" "" "" "rf" "" "" "rf" "" "" "rf" ""
## PredictorMatrix:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## X1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## X2 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
## X3 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
## X4 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
## X5 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
## X6 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1summary(train.dataindex$X1)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 4.20 15.39 18.30 18.57 21.90 33.50 8my_imp$imp$X1final_clean_ds = complete(my_imp,2)
final_clean_dsSetelah dilakukan handling pada missing value dengan metode rf maka didapatkan data baru seperti tabel di atas untuk selanjutnya akan digunakan untuk membangun model dengan klasifikasi adaboost.
# Cek data hilang Sebelum imputation
sapply(train.dataindex, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 8 0 0 0 0 0 0 7 0 0 18 0 0 10 0# Cek data hilang Setelah imputation
sapply(final_clean_ds, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0#Compare dimensi data sebelum dan sesudah imputation
dim(train.dataindex)## [1] 95 15dim(final_clean_ds)## [1] 95 15Secara keseluruhan, dari data yang kita punya terlihat bahwa jumlah negara yang masuk ke dalam kategori highsebanyak 64 negara, dan low 53 negara, sehingga proporsinya cukup balance. Selain itu terdapat 55 data hilang yang terletak pada variabel X1, x8, X11, dan X14. Dengan menggunakan package MICE metode rf didapatkan nilai-nilai dugaan dari data hilang tersebut, untuk selanjutnya dilakukan pengklasifikasian dengan metode adaboost.
#Grouping data yang hilang
bind_shadow(final_clean_ds)#Melihat sebaran estimasi data hilang
graph_rf<-train.dataindex%>%
bind_shadow() %>%
ggplot(aes(x= final_clean_ds$X1,
y = final_clean_ds$X2, color = X1_NA)) + geom_point()
graph_rf
Terlihat bahwa hasil pendugaan data hilang dengan menggunakan metode rf, estimasi data hilang menyebar mengikuti pola data yang ada.
Generate Model
Setelah tahap cleaning data selesai, selanjutnya kita akan lanjutkan dengan pembuatan model dengan metode adaboost sebagai berikut.
#membangun model dengan algoritma adaboost
model.adaboost <- boosting(Y~., data=train.dataindex,
mfinal=500, control=rpart.control(maxdepth=1),
coeflearn='Freund')
#menampilkan stump pertama
model.adaboost$trees[1]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 47 low (0.4947368 0.5052632)
## 2) X2< 5805.731 32 1 high (0.9687500 0.0312500) *
## 3) X2>=5805.731 63 16 low (0.2539683 0.7460317) *#menampilkan bobot dari stump pertama
model.adaboost$weights[1]## [1] 1.259543#menampilkan stump kedua
model.adaboost$trees[2]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 38 high (0.6000000 0.4000000)
## 2) X11>=3.79115 45 5 high (0.8888889 0.1111111) *
## 3) X11< 3.79115 50 17 low (0.3400000 0.6600000) *#menampilkan bobot dari stump kedua
model.adaboost$weights[2]## [1] 1.004702Untuk mengilustrasikan bagaimana proses prediksi final menggunakan 500 pohon, program berikut ini melakukan secara berurutan hal-hal berikut:
menentukan amatan yang mau diprediksi (diambil dari salah satu data yang ada pada data testing)
memprediksi menggunakan pohon/stump pertama, kedua, hingga yang kelima ratus
menjumlahkan bobot untuk prediksi kategori 0
menjumlahkan bobot untuk prediksi kategori 1
menentukan kelas mana yang suaranya paling tinggi, dan itu adalah kelas prediksinya
Sebagai pembanding, dilakukan juga prediksi langsung menggunakan model hasil boosting.
Data Prediction (Simulation)
Untuk menguji model yang sudah kita buat, selanjutnya akan dilakukan pengujian dengan menggunakan data test yang sudah kita siapkan sebelumnya.
prediksi1 <- test.dataindex[1,]
prediksi.adaboost1<- predict(model.adaboost, prediksi1)$class
prediksi.adaboost1## [1] "low"Disimpulkan dari stump yang pertama masuk ke dalam kategori high.
Data Prediction (Total)
prediksi.adaboost.2 <- predict(model.adaboost, test.dataindex)$class
confusionMatrix(as.factor(prediksi.adaboost.2),
test.dataindex$Y, positive = "high")## Confusion Matrix and Statistics
##
## Reference
## Prediction high low
## high 12 1
## low 0 9
##
## Accuracy : 0.9545
## 95% CI : (0.7716, 0.9988)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : 3.126e-05
##
## Kappa : 0.9076
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 1.0000
## Specificity : 0.9000
## Pos Pred Value : 0.9231
## Neg Pred Value : 1.0000
## Prevalence : 0.5455
## Detection Rate : 0.5455
## Detection Prevalence : 0.5909
## Balanced Accuracy : 0.9500
##
## 'Positive' Class : high
## Model Evaluation
Selanjutnya kita evaluasi model yang sudah kita buat dengan summary data uji sebagai berikut ini.
prediksi.adaboost.3<- predict(model.adaboost, test.dataindex, type = "prob")
dim(prediksi.adaboost.3$prob)## [1] 22 2ROCval2 <- rocit(score=prediksi.adaboost.3$prob[,2],class=test.dataindex$Y)
plot(ROCval2)
AUC9 <- ROCval2$AUC
AUC9## [1] 0.9916667Nilai AUC yang dihasilkan sangat baik yaitu 0,95. Artinya metode adaboosting ini bisa mengklasifikasikan data dengan baik ke dalam kategori high ataupun low didukung dengan nilai sensitivty dan spesifisity yang cukup baik (1,0 dan 0,7)
AdaBoost Simulasi 2 (pmm)
Pada simulasi yang kedua ini, pendugaan data hilang nya menggunkan metode pmm dari package MICE.
set.seed(123)
index2 <- createDataPartition(data$Y, p = 0.8,list = FALSE)
#membagi data menjadi data train dan data test
train.dataindex2 <- data[index2,]
dim(train.dataindex2)## [1] 95 15test.dataindex2 <- data[-index2,]
dim(test.dataindex2)## [1] 22 15Data dipisahkan menjadi data trianing dan testing masing-masing 95 observasi dan 22 observasi. Data training selanjutnya akan digunakan sebagai pembangun model, sedangkan data testing sebagai penguji model.
Cleaning Data
Pada ulasan ini akan dicoba pendugaan missing value dengan pendekatan metode pmm pada package MICE.
#Handling missing values dengan MICE Metode pmm
my_imp_pmm<- mice(train.dataindex2, m = 5, method = "pmm", maxit = 20, seed = 5200)##
## iter imp variable
## 1 1 X1 X8 X11 X14
## 1 2 X1 X8 X11 X14
## 1 3 X1 X8 X11 X14
## 1 4 X1 X8 X11 X14
## 1 5 X1 X8 X11 X14
## 2 1 X1 X8 X11 X14
## 2 2 X1 X8 X11 X14
## 2 3 X1 X8 X11 X14
## 2 4 X1 X8 X11 X14
## 2 5 X1 X8 X11 X14
## 3 1 X1 X8 X11 X14
## 3 2 X1 X8 X11 X14
## 3 3 X1 X8 X11 X14
## 3 4 X1 X8 X11 X14
## 3 5 X1 X8 X11 X14
## 4 1 X1 X8 X11 X14
## 4 2 X1 X8 X11 X14
## 4 3 X1 X8 X11 X14
## 4 4 X1 X8 X11 X14
## 4 5 X1 X8 X11 X14
## 5 1 X1 X8 X11 X14
## 5 2 X1 X8 X11 X14
## 5 3 X1 X8 X11 X14
## 5 4 X1 X8 X11 X14
## 5 5 X1 X8 X11 X14
## 6 1 X1 X8 X11 X14
## 6 2 X1 X8 X11 X14
## 6 3 X1 X8 X11 X14
## 6 4 X1 X8 X11 X14
## 6 5 X1 X8 X11 X14
## 7 1 X1 X8 X11 X14
## 7 2 X1 X8 X11 X14
## 7 3 X1 X8 X11 X14
## 7 4 X1 X8 X11 X14
## 7 5 X1 X8 X11 X14
## 8 1 X1 X8 X11 X14
## 8 2 X1 X8 X11 X14
## 8 3 X1 X8 X11 X14
## 8 4 X1 X8 X11 X14
## 8 5 X1 X8 X11 X14
## 9 1 X1 X8 X11 X14
## 9 2 X1 X8 X11 X14
## 9 3 X1 X8 X11 X14
## 9 4 X1 X8 X11 X14
## 9 5 X1 X8 X11 X14
## 10 1 X1 X8 X11 X14
## 10 2 X1 X8 X11 X14
## 10 3 X1 X8 X11 X14
## 10 4 X1 X8 X11 X14
## 10 5 X1 X8 X11 X14
## 11 1 X1 X8 X11 X14
## 11 2 X1 X8 X11 X14
## 11 3 X1 X8 X11 X14
## 11 4 X1 X8 X11 X14
## 11 5 X1 X8 X11 X14
## 12 1 X1 X8 X11 X14
## 12 2 X1 X8 X11 X14
## 12 3 X1 X8 X11 X14
## 12 4 X1 X8 X11 X14
## 12 5 X1 X8 X11 X14
## 13 1 X1 X8 X11 X14
## 13 2 X1 X8 X11 X14
## 13 3 X1 X8 X11 X14
## 13 4 X1 X8 X11 X14
## 13 5 X1 X8 X11 X14
## 14 1 X1 X8 X11 X14
## 14 2 X1 X8 X11 X14
## 14 3 X1 X8 X11 X14
## 14 4 X1 X8 X11 X14
## 14 5 X1 X8 X11 X14
## 15 1 X1 X8 X11 X14
## 15 2 X1 X8 X11 X14
## 15 3 X1 X8 X11 X14
## 15 4 X1 X8 X11 X14
## 15 5 X1 X8 X11 X14
## 16 1 X1 X8 X11 X14
## 16 2 X1 X8 X11 X14
## 16 3 X1 X8 X11 X14
## 16 4 X1 X8 X11 X14
## 16 5 X1 X8 X11 X14
## 17 1 X1 X8 X11 X14
## 17 2 X1 X8 X11 X14
## 17 3 X1 X8 X11 X14
## 17 4 X1 X8 X11 X14
## 17 5 X1 X8 X11 X14
## 18 1 X1 X8 X11 X14
## 18 2 X1 X8 X11 X14
## 18 3 X1 X8 X11 X14
## 18 4 X1 X8 X11 X14
## 18 5 X1 X8 X11 X14
## 19 1 X1 X8 X11 X14
## 19 2 X1 X8 X11 X14
## 19 3 X1 X8 X11 X14
## 19 4 X1 X8 X11 X14
## 19 5 X1 X8 X11 X14
## 20 1 X1 X8 X11 X14
## 20 2 X1 X8 X11 X14
## 20 3 X1 X8 X11 X14
## 20 4 X1 X8 X11 X14
## 20 5 X1 X8 X11 X14summary(my_imp_pmm)## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13
## "pmm" "" "" "" "" "" "" "pmm" "" "" "pmm" "" ""
## X14 Y
## "pmm" ""
## PredictorMatrix:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## X1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## X2 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
## X3 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
## X4 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
## X5 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
## X6 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1my_imp_pmm$imp$X1final_clean_ds_pmm = complete(my_imp_pmm,3)
final_clean_ds_pmm#Cek Missing values
anyNA(final_clean_ds_pmm)## [1] FALSESelanjutnya kita cek komparasi data sebelum dan sesudah proses imputation untuk memastikan bahwa data hilang sudah teratasi dengan baik.
# Cek data hilang Sebelum imputation
sapply(train.dataindex2, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 12 0 0 0 0 0 0 8 0 0 18 0 0 11 0# Cek data hilang Setelah imputation
sapply(final_clean_ds_pmm, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0#Compare dimensi data sebelum dan sesudah imputation
dim(train.dataindex)## [1] 95 15dim(final_clean_ds_pmm)## [1] 95 15Secara keseluruha, dari data yang kita punya terlihat bahwa jumlah negara yang masuk ke dalam kategori highsebanyak 64 negara, dan low 53 negara, sehingga proporsinya cukup balance. Selain itu terdapat 55 data hilang yang terletak pada variabel X1, x8, X11, dan X14. Dengan menggunakan package MICE metode pmm didapatkan nilai-nilai dugaan dari data hilang tersebut, untuk selanjutnya dilakukan pengklasifikasian dengan metode adaboost.
#Grouping data yang hilang
bind_shadow(final_clean_ds_pmm)#Melihat sebaran estimasi data hilang
graph_pmm<-train.dataindex2%>%
bind_shadow() %>%
ggplot(aes(x= final_clean_ds_pmm$X1,
y = final_clean_ds_pmm$X2, color = X1_NA)) + geom_point()
graph_pmm
Terlihat bahwa hasil pendugaan data hilang dengan menggunakan metode pmm, estimasi data hilang menyebar mengikuti pola data yang ada.
Generate Model
Setelah tahap cleaning data selesai, selanjutnya kita akan lanjutkan dengan pembuatan model dengan metode adaboost sebagai berikut.
#membangun model dengan algoritma adaboost
model.adaboost2 <- boosting(Y~., data=train.dataindex2,
mfinal=500, control=rpart.control(maxdepth=1),
coeflearn='Freund')
#menampilkan stump pertama
model.adaboost2$trees[1]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 40 high (0.57894737 0.42105263)
## 2) X2< 17175.26 65 11 high (0.83076923 0.16923077) *
## 3) X2>=17175.26 30 1 low (0.03333333 0.96666667) *#menampilkan bobot dari stump pertama
model.adaboost2$weights[1]## [1] 2.032922#menampilkan stump kedua
model.adaboost2$trees[2]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 40 low (0.4210526 0.5789474)
## 2) X14>=10 25 0 high (1.0000000 0.0000000) *
## 3) X14< 10 70 15 low (0.2142857 0.7857143) *#menampilkan bobot dari stump kedua
model.adaboost2$weights[2]## [1] 1.142383Untuk mengilustrasikan bagaimana proses prediksi final menggunakan 500 pohon, program berikut ini melakukan secara berurutan hal-hal berikut:
menentukan amatan yang mau diprediksi (diambil dari salah satu data yang ada pada data testing)
memprediksi menggunakan pohon/stump pertama, kedua, hingga yang kelima ratus
menjumlahkan bobot untuk prediksi kategori 0
menjumlahkan bobot untuk prediksi kategori 1
menentukan kelas mana yang suaranya paling tinggi, dan itu adalah kelas prediksinya
Sebagai pembanding, dilakukan juga prediksi langsung menggunakan model hasil boosting.
Data Prediction (Simulation)
Untuk menguji model yang sudah kita buat, selanjutnya akan dilakukan pengujian dengan menggunakan data test yang sudah kita siapkan sebelumnya.
prediksi11 <- test.dataindex2[1,]
prediksi.adaboost11<- predict(model.adaboost2, prediksi11)$class
prediksi.adaboost11## [1] "high"Disimpulkan dari stump yang pertama masuk ke dalam kategori high.
Data Prediction (Total)
prediksi.adaboost.22 <- predict(model.adaboost2, test.dataindex2)$class
confusionMatrix(as.factor(prediksi.adaboost.22),
test.dataindex2$Y, positive = "high")## Confusion Matrix and Statistics
##
## Reference
## Prediction high low
## high 10 2
## low 2 8
##
## Accuracy : 0.8182
## 95% CI : (0.5972, 0.9481)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : 0.007436
##
## Kappa : 0.6333
##
## Mcnemar's Test P-Value : 1.000000
##
## Sensitivity : 0.8333
## Specificity : 0.8000
## Pos Pred Value : 0.8333
## Neg Pred Value : 0.8000
## Prevalence : 0.5455
## Detection Rate : 0.4545
## Detection Prevalence : 0.5455
## Balanced Accuracy : 0.8167
##
## 'Positive' Class : high
## Model Evaluation
Selanjutnya kita evaluasi model yang sudah kita buat dengan summary data uji sebagai berikut ini.
prediksi.adaboost.33<- predict(model.adaboost2, test.dataindex2, type = "prob")
dim(prediksi.adaboost.33$prob)## [1] 22 2ROCval22 <- rocit(score=prediksi.adaboost.33$prob[,2],class=test.dataindex2$Y)
plot(ROCval22)
AUC99 <- ROCval22$AUC
AUC99## [1] 0.9166667Nilai AUC yang dihasilkan yaitu 0,92. Artinya metode adaboosting yang pendugaan data hilang nya dengan menggunakan metode pmm ini bisa mengklasifikasikan data dengan cukup baik ke dalam kategori high ataupun low didukung dengan nilai sensitivty dan spesivisity yang cukup baik (0.75 dan 0,7).
AdaBoost Simulasi 3 (mean)
Pada simulasi yang ketiga ini, pendugaan data hilang nya menggunkan metode mean dari package MICE.
set.seed(1234)
index22 <- createDataPartition(data$Y, p = 0.8,list = FALSE)
#membagi data menjadi data train dan data test
train.dataindex22 <- data[index22,]
dim(train.dataindex22)## [1] 95 15test.dataindex22 <- data[-index22,]
dim(test.dataindex22)## [1] 22 15Data dipisahkan menjadi data trianing dan testing masing-masing 95 observasi dan 22 observasi. Data training selanjutnya akan digunakan sebagai pembangun model, sedangkan data testing sebagai penguji model.
Cleaning Data
Pada ulasan ini akan dicoba pendugaan missing value dengan pendekatan metode mean pada package MICE.
#Handling missing values dengan MICE Metode pmm
my_imp_mean<- mice(train.dataindex22, m = 5, method = "mean", maxit = 20, seed = 200)##
## iter imp variable
## 1 1 X1 X8 X11 X14
## 1 2 X1 X8 X11 X14
## 1 3 X1 X8 X11 X14
## 1 4 X1 X8 X11 X14
## 1 5 X1 X8 X11 X14
## 2 1 X1 X8 X11 X14
## 2 2 X1 X8 X11 X14
## 2 3 X1 X8 X11 X14
## 2 4 X1 X8 X11 X14
## 2 5 X1 X8 X11 X14
## 3 1 X1 X8 X11 X14
## 3 2 X1 X8 X11 X14
## 3 3 X1 X8 X11 X14
## 3 4 X1 X8 X11 X14
## 3 5 X1 X8 X11 X14
## 4 1 X1 X8 X11 X14
## 4 2 X1 X8 X11 X14
## 4 3 X1 X8 X11 X14
## 4 4 X1 X8 X11 X14
## 4 5 X1 X8 X11 X14
## 5 1 X1 X8 X11 X14
## 5 2 X1 X8 X11 X14
## 5 3 X1 X8 X11 X14
## 5 4 X1 X8 X11 X14
## 5 5 X1 X8 X11 X14
## 6 1 X1 X8 X11 X14
## 6 2 X1 X8 X11 X14
## 6 3 X1 X8 X11 X14
## 6 4 X1 X8 X11 X14
## 6 5 X1 X8 X11 X14
## 7 1 X1 X8 X11 X14
## 7 2 X1 X8 X11 X14
## 7 3 X1 X8 X11 X14
## 7 4 X1 X8 X11 X14
## 7 5 X1 X8 X11 X14
## 8 1 X1 X8 X11 X14
## 8 2 X1 X8 X11 X14
## 8 3 X1 X8 X11 X14
## 8 4 X1 X8 X11 X14
## 8 5 X1 X8 X11 X14
## 9 1 X1 X8 X11 X14
## 9 2 X1 X8 X11 X14
## 9 3 X1 X8 X11 X14
## 9 4 X1 X8 X11 X14
## 9 5 X1 X8 X11 X14
## 10 1 X1 X8 X11 X14
## 10 2 X1 X8 X11 X14
## 10 3 X1 X8 X11 X14
## 10 4 X1 X8 X11 X14
## 10 5 X1 X8 X11 X14
## 11 1 X1 X8 X11 X14
## 11 2 X1 X8 X11 X14
## 11 3 X1 X8 X11 X14
## 11 4 X1 X8 X11 X14
## 11 5 X1 X8 X11 X14
## 12 1 X1 X8 X11 X14
## 12 2 X1 X8 X11 X14
## 12 3 X1 X8 X11 X14
## 12 4 X1 X8 X11 X14
## 12 5 X1 X8 X11 X14
## 13 1 X1 X8 X11 X14
## 13 2 X1 X8 X11 X14
## 13 3 X1 X8 X11 X14
## 13 4 X1 X8 X11 X14
## 13 5 X1 X8 X11 X14
## 14 1 X1 X8 X11 X14
## 14 2 X1 X8 X11 X14
## 14 3 X1 X8 X11 X14
## 14 4 X1 X8 X11 X14
## 14 5 X1 X8 X11 X14
## 15 1 X1 X8 X11 X14
## 15 2 X1 X8 X11 X14
## 15 3 X1 X8 X11 X14
## 15 4 X1 X8 X11 X14
## 15 5 X1 X8 X11 X14
## 16 1 X1 X8 X11 X14
## 16 2 X1 X8 X11 X14
## 16 3 X1 X8 X11 X14
## 16 4 X1 X8 X11 X14
## 16 5 X1 X8 X11 X14
## 17 1 X1 X8 X11 X14
## 17 2 X1 X8 X11 X14
## 17 3 X1 X8 X11 X14
## 17 4 X1 X8 X11 X14
## 17 5 X1 X8 X11 X14
## 18 1 X1 X8 X11 X14
## 18 2 X1 X8 X11 X14
## 18 3 X1 X8 X11 X14
## 18 4 X1 X8 X11 X14
## 18 5 X1 X8 X11 X14
## 19 1 X1 X8 X11 X14
## 19 2 X1 X8 X11 X14
## 19 3 X1 X8 X11 X14
## 19 4 X1 X8 X11 X14
## 19 5 X1 X8 X11 X14
## 20 1 X1 X8 X11 X14
## 20 2 X1 X8 X11 X14
## 20 3 X1 X8 X11 X14
## 20 4 X1 X8 X11 X14
## 20 5 X1 X8 X11 X14summary(my_imp_mean)## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11
## "mean" "" "" "" "" "" "" "mean" "" "" "mean"
## X12 X13 X14 Y
## "" "" "mean" ""
## PredictorMatrix:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## X1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## X2 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
## X3 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
## X4 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
## X5 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
## X6 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1my_imp_mean$imp$X1final_clean_ds_mean = complete(my_imp_mean,1)
final_clean_ds_mean#Cek Missing values
anyNA(final_clean_ds_mean)## [1] FALSESelanjutnya kita cek komparasi data sebelum dan sesudah proses imputation untuk memastikan bahwa data hilang sudah teratasi dengan baik.
# Cek data hilang Sebelum imputation
sapply(train.dataindex22, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 11 0 0 0 0 0 0 6 0 0 15 0 0 9 0# Cek data hilang Setelah imputation
sapply(final_clean_ds_mean, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0#Compare dimensi data sebelum dan sesudah imputation
dim(train.dataindex22 )## [1] 95 15dim(final_clean_ds_mean)## [1] 95 15Secara keseluruha, dari data yang kita punya terlihat bahwa jumlah negara yang masuk ke dalam kategori highsebanyak 64 negara, dan low 53 negara, sehingga proporsinya cukup balance. Selain itu terdapat 55 data hilang yang terletak pada variabel X1, x8, X11, dan X14. Dengan menggunakan package MICE metode mean didapatkan nilai-nilai dugaan dari data hilang tersebut, untuk selanjutnya dilakukan pengklasifikasian dengan metode adaboost.
#Grouping data yang hilang
bind_shadow(final_clean_ds_mean)#Melihat sebaran estimasi data hilang
graph_mean<-train.dataindex22%>%
bind_shadow() %>%
ggplot(aes(x= final_clean_ds_mean$X1,
y = final_clean_ds_mean$X2, color = X1_NA)) + geom_point()
graph_mean
Terlihat bahwa hasil pendugaan data hilang dengan menggunakan metode mean, estimasi data hilang berkumpul di satu titik average.
Generate Model
Setelah tahap cleaning data selesai, selanjutnya kita akan lanjutkan dengan pembuatan model dengan metode adaboost sebagai berikut.
#membangun model dengan algoritma adaboost
model.adaboost22 <- boosting(Y~., data=train.dataindex22,
mfinal=500, control=rpart.control(maxdepth=1),
coeflearn='Freund')
#menampilkan stump pertama
model.adaboost22$trees[1]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 42 high (0.5578947 0.4421053)
## 2) X2< 17175.26 55 7 high (0.8727273 0.1272727) *
## 3) X2>=17175.26 40 5 low (0.1250000 0.8750000) *#menampilkan bobot dari stump pertama
model.adaboost22$weights[1]## [1] 1.84177#menampilkan stump kedua
model.adaboost22$trees[2]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 45 high (0.5263158 0.4736842)
## 2) X11>=4.16335 44 5 high (0.8863636 0.1136364) *
## 3) X11< 4.16335 51 11 low (0.2156863 0.7843137) *#menampilkan bobot dari stump kedua
model.adaboost22$weights[2]## [1] 1.133947Untuk mengilustrasikan bagaimana proses prediksi final menggunakan 500 pohon, program berikut ini melakukan secara berurutan hal-hal berikut:
menentukan amatan yang mau diprediksi (diambil dari salah satu data yang ada pada data testing)
memprediksi menggunakan pohon/stump pertama, kedua, hingga yang kelima ratus
menjumlahkan bobot untuk prediksi kategori 0
menjumlahkan bobot untuk prediksi kategori 1
menentukan kelas mana yang suaranya paling tinggi, dan itu adalah kelas prediksinya
Sebagai pembanding, dilakukan juga prediksi langsung menggunakan model hasil boosting.
Data Prediction (Simulation)
Untuk menguji model yang sudah kita buat, selanjutnya akan dilakukan pengujian dengan menggunakan data test yang sudah kita siapkan sebelumnya.
prediksi111 <- test.dataindex22[1,]
prediksi.adaboost111<- predict(model.adaboost22, prediksi111)$class
prediksi.adaboost111## [1] "low"Disimpulkan dari stump yang pertama masuk ke dalam kategori low.
Data Prediction (Total)
prediksi.adaboost.222 <- predict(model.adaboost22, test.dataindex22)$class
confusionMatrix(as.factor(prediksi.adaboost.222),
test.dataindex22$Y, positive = "high")## Confusion Matrix and Statistics
##
## Reference
## Prediction high low
## high 10 1
## low 2 9
##
## Accuracy : 0.8636
## 95% CI : (0.6509, 0.9709)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : 0.001732
##
## Kappa : 0.7273
##
## Mcnemar's Test P-Value : 1.000000
##
## Sensitivity : 0.8333
## Specificity : 0.9000
## Pos Pred Value : 0.9091
## Neg Pred Value : 0.8182
## Prevalence : 0.5455
## Detection Rate : 0.4545
## Detection Prevalence : 0.5000
## Balanced Accuracy : 0.8667
##
## 'Positive' Class : high
## Model Evaluation
Selanjutnya kita evaluasi model yang sudah kita buat dengan summary data uji sebagai berikut ini.
prediksi.adaboost.333<- predict(model.adaboost22, test.dataindex22, type = "prob")
dim(prediksi.adaboost.333$prob)## [1] 22 2ROCval222 <- rocit(score=prediksi.adaboost.333$prob[,2],class=test.dataindex22$Y)
plot(ROCval222)
AUC999 <- ROCval222$AUC
AUC999## [1] 0.95Nilai AUC yang dihasilkan cukup tinggi yaitu 0,96. Namun nilai dari sensitivty nya cukup rendah yaitu 0,75 meski nilai spesificitynya cukup baik yaitu 0,90. Hal ini mengindikasikan bahwa dengan pendekatan missing data metode mean ini peluang menduga kategori low dengan benar adalah 0,75, sedangkan 0,25 nya berpeluang salah dalam mengelompokkan.
AdaBoost Simulasi 4 (norm)
Pada simulasi yang keempat ini, pendugaan data hilang nya menggunkan metode norm dari package MICE.
set.seed(12346)
index222 <- createDataPartition(data$Y, p = 0.8,list = FALSE)
#membagi data menjadi data train dan data test
train.dataindex222 <- data[index222,]
dim(train.dataindex222)## [1] 95 15test.dataindex222 <- data[-index222,]
dim(test.dataindex222)## [1] 22 15Data dipisahkan menjadi data trianing dan testing masing-masing 95 observasi dan 22 observasi. Data training selanjutnya akan digunakan sebagai pembangun model, sedangkan data testing sebagai penguji model.
Cleaning Data
Pada ulasan ini akan dicoba pendugaan missing value dengan pendekatan metode norm pada package MICE.
#Handling missing values dengan MICE Metode norm
my_imp_norm<- mice(train.dataindex222, m = 5, method = "norm", maxit = 20, seed = 200)##
## iter imp variable
## 1 1 X1 X8 X11 X14
## 1 2 X1 X8 X11 X14
## 1 3 X1 X8 X11 X14
## 1 4 X1 X8 X11 X14
## 1 5 X1 X8 X11 X14
## 2 1 X1 X8 X11 X14
## 2 2 X1 X8 X11 X14
## 2 3 X1 X8 X11 X14
## 2 4 X1 X8 X11 X14
## 2 5 X1 X8 X11 X14
## 3 1 X1 X8 X11 X14
## 3 2 X1 X8 X11 X14
## 3 3 X1 X8 X11 X14
## 3 4 X1 X8 X11 X14
## 3 5 X1 X8 X11 X14
## 4 1 X1 X8 X11 X14
## 4 2 X1 X8 X11 X14
## 4 3 X1 X8 X11 X14
## 4 4 X1 X8 X11 X14
## 4 5 X1 X8 X11 X14
## 5 1 X1 X8 X11 X14
## 5 2 X1 X8 X11 X14
## 5 3 X1 X8 X11 X14
## 5 4 X1 X8 X11 X14
## 5 5 X1 X8 X11 X14
## 6 1 X1 X8 X11 X14
## 6 2 X1 X8 X11 X14
## 6 3 X1 X8 X11 X14
## 6 4 X1 X8 X11 X14
## 6 5 X1 X8 X11 X14
## 7 1 X1 X8 X11 X14
## 7 2 X1 X8 X11 X14
## 7 3 X1 X8 X11 X14
## 7 4 X1 X8 X11 X14
## 7 5 X1 X8 X11 X14
## 8 1 X1 X8 X11 X14
## 8 2 X1 X8 X11 X14
## 8 3 X1 X8 X11 X14
## 8 4 X1 X8 X11 X14
## 8 5 X1 X8 X11 X14
## 9 1 X1 X8 X11 X14
## 9 2 X1 X8 X11 X14
## 9 3 X1 X8 X11 X14
## 9 4 X1 X8 X11 X14
## 9 5 X1 X8 X11 X14
## 10 1 X1 X8 X11 X14
## 10 2 X1 X8 X11 X14
## 10 3 X1 X8 X11 X14
## 10 4 X1 X8 X11 X14
## 10 5 X1 X8 X11 X14
## 11 1 X1 X8 X11 X14
## 11 2 X1 X8 X11 X14
## 11 3 X1 X8 X11 X14
## 11 4 X1 X8 X11 X14
## 11 5 X1 X8 X11 X14
## 12 1 X1 X8 X11 X14
## 12 2 X1 X8 X11 X14
## 12 3 X1 X8 X11 X14
## 12 4 X1 X8 X11 X14
## 12 5 X1 X8 X11 X14
## 13 1 X1 X8 X11 X14
## 13 2 X1 X8 X11 X14
## 13 3 X1 X8 X11 X14
## 13 4 X1 X8 X11 X14
## 13 5 X1 X8 X11 X14
## 14 1 X1 X8 X11 X14
## 14 2 X1 X8 X11 X14
## 14 3 X1 X8 X11 X14
## 14 4 X1 X8 X11 X14
## 14 5 X1 X8 X11 X14
## 15 1 X1 X8 X11 X14
## 15 2 X1 X8 X11 X14
## 15 3 X1 X8 X11 X14
## 15 4 X1 X8 X11 X14
## 15 5 X1 X8 X11 X14
## 16 1 X1 X8 X11 X14
## 16 2 X1 X8 X11 X14
## 16 3 X1 X8 X11 X14
## 16 4 X1 X8 X11 X14
## 16 5 X1 X8 X11 X14
## 17 1 X1 X8 X11 X14
## 17 2 X1 X8 X11 X14
## 17 3 X1 X8 X11 X14
## 17 4 X1 X8 X11 X14
## 17 5 X1 X8 X11 X14
## 18 1 X1 X8 X11 X14
## 18 2 X1 X8 X11 X14
## 18 3 X1 X8 X11 X14
## 18 4 X1 X8 X11 X14
## 18 5 X1 X8 X11 X14
## 19 1 X1 X8 X11 X14
## 19 2 X1 X8 X11 X14
## 19 3 X1 X8 X11 X14
## 19 4 X1 X8 X11 X14
## 19 5 X1 X8 X11 X14
## 20 1 X1 X8 X11 X14
## 20 2 X1 X8 X11 X14
## 20 3 X1 X8 X11 X14
## 20 4 X1 X8 X11 X14
## 20 5 X1 X8 X11 X14summary(my_imp_norm)## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11
## "norm" "" "" "" "" "" "" "norm" "" "" "norm"
## X12 X13 X14 Y
## "" "" "norm" ""
## PredictorMatrix:
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## X1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## X2 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
## X3 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
## X4 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
## X5 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
## X6 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1my_imp_norm$imp$X1final_clean_ds_norm = complete(my_imp_norm,1)
final_clean_ds_norm#Cek Missing values
anyNA(final_clean_ds_norm)## [1] FALSESelanjutnya kita cek komparasi data sebelum dan sesudah proses imputation untuk memastikan bahwa data hilang sudah teratasi dengan baik.
# Cek data hilang Sebelum imputation
sapply(train.dataindex222, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 11 0 0 0 0 0 0 6 0 0 16 0 0 10 0# Cek data hilang Setelah imputation
sapply(final_clean_ds_norm, function(x) sum(is.na(x)))## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Y
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0#Compare dimensi data sebelum dan sesudah imputation
dim(train.dataindex222)## [1] 95 15dim(final_clean_ds_norm)## [1] 95 15Secara keseluruha, dari data yang kita punya terlihat bahwa jumlah negara yang masuk ke dalam kategori highsebanyak 64 negara, dan low 53 negara, sehingga proporsinya cukup balance. Selain itu terdapat 55 data hilang yang terletak pada variabel X1, x8, X11, dan X14. Dengan menggunakan package MICE metode norm didapatkan nilai-nilai dugaan dari data hilang tersebut, untuk selanjutnya dilakukan pengklasifikasian dengan metode adaboost.
#Grouping data yang hilang
bind_shadow(final_clean_ds_norm)#Melihat sebaran estimasi data hilang
graph_norm<-train.dataindex222%>%
bind_shadow() %>%
ggplot(aes(x= final_clean_ds_norm$X1,
y = final_clean_ds_norm$X2, color = X1_NA)) + geom_point()
graph_norm
Terlihat bahwa hasil pendugaan data hilang dengan menggunakan metode norm, estimasi data hilang menyebar mengikuti pola data yang ada.
Generate Model
Setelah tahap cleaning data selesai, selanjutnya kita akan lanjutkan dengan pembuatan model dengan metode adaboost sebagai berikut.
#membangun model dengan algoritma adaboost
model.adaboost222 <- boosting(Y~., data=train.dataindex222,
mfinal=500, control=rpart.control(maxdepth=1),
coeflearn='Freund')
#menampilkan stump pertama
model.adaboost222$trees[1]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 37 high (0.61052632 0.38947368)
## 2) X2< 18127.99 57 4 high (0.92982456 0.07017544) *
## 3) X2>=18127.99 38 5 low (0.13157895 0.86842105) *#menampilkan bobot dari stump pertama
model.adaboost222$weights[1]## [1] 1.673976#menampilkan stump kedua
model.adaboost222$trees[2]## [[1]]
## n= 95
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 95 43 high (0.5473684 0.4526316)
## 2) X11>=4.16335 46 6 high (0.8695652 0.1304348) *
## 3) X11< 4.16335 49 12 low (0.2448980 0.7551020) *#menampilkan bobot dari stump kedua
model.adaboost222$weights[2]## [1] 1.322416Untuk mengilustrasikan bagaimana proses prediksi final menggunakan 500 pohon, program berikut ini melakukan secara berurutan hal-hal berikut:
menentukan amatan yang mau diprediksi (diambil dari salah satu data yang ada pada data testing)
memprediksi menggunakan pohon/stump pertama, kedua, hingga yang kelima ratus
menjumlahkan bobot untuk prediksi kategori 0
menjumlahkan bobot untuk prediksi kategori 1
menentukan kelas mana yang suaranya paling tinggi, dan itu adalah kelas prediksinya
Sebagai pembanding, dilakukan juga prediksi langsung menggunakan model hasil boosting.
Data Prediction (Simulation)
Untuk menguji model yang sudah kita buat, selanjutnya akan dilakukan pengujian dengan menggunakan data test yang sudah kita siapkan sebelumnya.
prediksi1111 <- test.dataindex222[1,]
prediksi.adaboost1111<- predict(model.adaboost222, prediksi1111)$class
prediksi.adaboost1111## [1] "low"Disimpulkan dari stump yang pertama masuk ke dalam kategori low.
Data Prediction (Total)
prediksi.adaboost.2222 <- predict(model.adaboost222, test.dataindex222)$class
confusionMatrix(as.factor(prediksi.adaboost.2222),
test.dataindex222$Y, positive = "high")## Confusion Matrix and Statistics
##
## Reference
## Prediction high low
## high 11 1
## low 1 9
##
## Accuracy : 0.9091
## 95% CI : (0.7084, 0.9888)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : 0.0002906
##
## Kappa : 0.8167
##
## Mcnemar's Test P-Value : 1.0000000
##
## Sensitivity : 0.9167
## Specificity : 0.9000
## Pos Pred Value : 0.9167
## Neg Pred Value : 0.9000
## Prevalence : 0.5455
## Detection Rate : 0.5000
## Detection Prevalence : 0.5455
## Balanced Accuracy : 0.9083
##
## 'Positive' Class : high
## Model Evaluation
Selanjutnya kita evaluasi model yang sudah kita buat dengan summary data uji sebagai berikut ini.
prediksi.adaboost.3333<- predict(model.adaboost222, test.dataindex222, type = "prob")
dim(prediksi.adaboost.3333$prob)## [1] 22 2ROCval2222 <- rocit(score=prediksi.adaboost.3333$prob[,2],class=test.dataindex222$Y)
plot(ROCval2222)
AUC9999 <- ROCval2222$AUC
AUC9999## [1] 0.9666667Nilai AUC yang dihasilkan cukup tinggi yaitu 0,97. Nilai dari sensitivty nya cukup tinggi yaitu 0,91, nilai spesificitynya yaitu 0,90. Hal ini mengindikasikan bahwa dengan pendekatan missing data metode norm dapat mengklasifikasikan data dengan sangat baik.
Model Comparation
Selanjutnya kita komparasi dari ke-empat metode pendugaan data hilang tersebut.
par <- par(mfrow=c(2, 2))
graph_norm
graph_mean
graph_pmm
graph_rf
AUC_model<-c(AUC9, AUC99, AUC999, AUC9999)
AUC_model<-round(AUC_model,2)
Model_Class<- c("Metode RF", "Metode pmm","Metode mean","Metode norm")
sensitivity_All<-c(1.00,0.75,0.75,0.91)
spesivisity_All<-c(0.7,0.70,0.90,0.90)
Accuracy_All<- c(0.86,0.72, 0.85,0.91)
komparasi.model<- cbind(Model_Class, AUC_model, sensitivity_All, spesivisity_All,Accuracy_All)
colnames(komparasi.model)<-c("Model", "AUC", "Sensitivity","Spesifisity", "Accuracy")
komparasi.model<-as.data.frame(komparasi.model)
komparasi.modelDari hasil komparasi di atas terlihat bahwa dari ke-empat metode di atas, maka dapat disimpulkan bahwa metode terbaik dalam menduga data hilang pada case ini adalah dengan metode norm.
Refference
Berikut adalah beberapa referensi yang digunakan sebagai rujukan dalam pembuatan model ini, khususnya penanganan missing data.
Camm, Jeffrey D. Business Analytics. Third edition, Cengage, 2019.
Dealing with Missing Values - UC Business Analytics R Programming Guide. Accessed April 19, 2021. Available here.
The Analysis Factor. “How to Diagnose the Missing Data Mechanism,” May 20, 2013. Available here.
https://rpubs.com/odenipinedo/dealing-with-missing-data-in-R