Random Forest

Study Kasus

Terdapat suatu data investasi dari 117 negara, Data ini menunjukan seberapa tinggi tingkat resiko investasi dari masing-masing negara tersebut. Adapun Beberapa variabel yang digunakan untuk mengukur tingkat resiko investasi adalah :

  • Country : Id setiap Negara
  • X1 : % Rata-rata rasio kecukupan modal 5 tahun terakhir
  • X2 : Produk Domestik Bruto per kapita (USD)
  • X3 : % Rata-rata Utang Luar Negeri Bruto 5 tahun terakhir
  • X4 : % Rata-rata pertumbuhan harga konsumen 5 tahun terakhir
  • X5 : % Rata-rata pertumbuhan penduduk 5 tahun terakhir
  • X6 : % Rata-rata PDB riil 5 tahun terakhir
  • X7 : % Rata-rata pertumbuhan PDB riil per kapita 5 tahun terakhir
  • X8 : % Rata-rata rasio pinjaman-deposit 5 tahun terakhir
  • X9 : % Rata-rata Utang Luar Negeri Bersih 5 tahun terakhir
  • X10 : Nominal PDB (US miliar)
  • X11 : % Rata-rata kredit bermasalah 5 tahun terakhir
  • X12 : % Rata-rata investasi domestik bruto terhadap PDB 5 tahun terakhir
  • X13 : % Rata-rata tabungan domestik bruto terhadap PDB 5 tahun terakhir
  • X14 : % Rata-rata tingkat pengangguran 5 tahun terakhir
  • Risk Level : Tingkat Resiko Investasi

Packages

library(caret)
library(vip)
library(Metrics)
library(mice)
library(pROC)
library(AppliedPredictiveModeling)
library(skimr)
library(randomForest)
library(DT)

Eksplorasi Data

data <- read.csv("C:/sqlite/db/investment_risk.csv")
str(data)
## 'data.frame':    117 obs. of  16 variables:
##  $ Country   : chr  "AD" "AE" "AE-AZ" "AE-RK" ...
##  $ 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 ...
##  $ Risk.Level: chr  "low" "low" "low" "low" ...
datatable(data)
data$Risk.Level = as.factor(data$Risk.Level)

featurePlot(x=data[,2:15],y= data$Risk.Level,
            plot="box", scales=list(x=list(relation="free"),
                                    y=list(relation="free"),auto.key=list(columns=3)))

Eksplorasi data dengan menggunakan box plot memberikan beberapa informasi diantaranya adalah persebaran data dari variablenya, banyaknya pencilan data, dan kesimetrisan data. contoh pada variable X1 dimana persebaran data high dan low berada sekitar nilai 10 hingga 20. tapi, nilai high memiliki beberpa pencilan pada bagian lower dan uper boxnya.

featurePlot(x=data[,2:15],y= data$Risk.Level,
            plot="density", scales=list(x=list(relation="free"),
                                    y=list(relation="free"),auto.key=list(columns=3)))

Untuk lebih melihat persebaran data dapat menggunakan graphic density data.

Pre-processing Data

Proses Pre-processing merupakan suatu proses yang dilakukan sebelum proses klasifikasi data. Preprocessing sendiri terbagi atas beberapa metode yaitu :

  • Cleanning data

  • Transformasi data

  • Reduksi data

Metode yang digunakan pada kali ini hanyalah cleansing data yang merupakan suatu penanganan terhadap missing value.

newdata <- data[,2:16] ## Membuang variable indeks
str(newdata)
## 'data.frame':    117 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 ...
##  $ Risk.Level: Factor w/ 2 levels "high","low": 2 2 2 2 1 1 1 2 2 1 ...
skimmed <- skim(newdata[,1:14]) ## Melihat summari data dan memeriksa terdapat adanya data hilang NA

skim <- skimmed[, c(1:6,12)] ## 1:6 -12 menunjukan apasaja summery yang ingin ditampilkan seperti mean,sd,NA dal=nlainya 
skim
Data summary
Name newdata[, 1:14]
Number of rows 117
Number of columns 14
_______________________
Column type frequency:
numeric 14
________________________
Group variables None

Variable type: numeric

skim_variable n_missing complete_rate mean sd hist
X1 13 0.89 18.73 5.18 ▁▇▃▁▁
X2 0 1.00 22596.35 24598.74 ▇▂▂▁▁
X3 0 1.00 177.50 646.02 ▇▁▁▁▁
X4 0 1.00 3.44 4.94 ▇▁▁▁▁
X5 0 1.00 1.15 1.05 ▃▇▅▂▁
X6 0 1.00 3.06 2.20 ▁▂▇▃▁
X7 0 1.00 0.22 2.50 ▁▁▆▇▂
X8 9 0.92 99.47 41.28 ▇▅▁▁▁
X9 0 1.00 -14.34 202.88 ▁▁▁▂▇
X10 0 1.00 710.34 2434.56 ▇▁▁▁▁
X11 21 0.82 6.31 8.92 ▇▁▁▁▁
X12 0 1.00 24.52 6.52 ▃▇▃▁▁
X13 0 1.00 24.36 8.19 ▅▇▆▁▁
X14 12 0.90 8.52 5.68 ▇▆▂▁▁ 
md.pattern(newdata)

##    X2 X3 X4 X5 X6 X7 X9 X10 X12 X13 Risk.Level X8 X14 X1 X11   
## 76  1  1  1  1  1  1  1   1   1   1          1  1   1  1   1  0
## 15  1  1  1  1  1  1  1   1   1   1          1  1   1  1   0  1
## 7   1  1  1  1  1  1  1   1   1   1          1  1   1  0   1  1
## 1   1  1  1  1  1  1  1   1   1   1          1  1   1  0   0  2
## 8   1  1  1  1  1  1  1   1   1   1          1  1   0  1   1  1
## 1   1  1  1  1  1  1  1   1   1   1          1  1   0  0   0  3
## 3   1  1  1  1  1  1  1   1   1   1          1  0   1  1   1  1
## 1   1  1  1  1  1  1  1   1   1   1          1  0   1  1   0  2
## 1   1  1  1  1  1  1  1   1   1   1          1  0   1  0   1  2
## 1   1  1  1  1  1  1  1   1   1   1          1  0   1  0   0  3
## 1   1  1  1  1  1  1  1   1   1   1          1  0   0  1   1  2
## 2   1  1  1  1  1  1  1   1   1   1          1  0   0  0   0  4
##     0  0  0  0  0  0  0   0   0   0          0  9  12 13  21 55

Berdasarkan skim data yang memperlihatkan hasil summary data diantaranya adalah mean, stamdar deviasi, bentuk persebaran setiap variable berdaarkan histogramnya dan nilai missing value pada setiap variablena. Hal yang paling di perhatikan adalah nilai missing value yang terdapat di beberapa variable seperti X1 memiliki 13 data hilang, X11 memiliki 21 data hilang, x8 memiliki 9 data hilang dan X14 memiliki 12 data hilang.

newdata <- mice(newdata, method="mean")
## 
##  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
newdata <- complete(newdata) 
md.pattern(newdata)
##  /\     /\
## {  `---'  }
## {  O   O  }
## ==>  V <==  No need for mice. This data set is completely observed.
##  \  \|/  /
##   `-----'

##     X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 Risk.Level  
## 117  1  1  1  1  1  1  1  1  1   1   1   1   1   1          1 0
##      0  0  0  0  0  0  0  0  0   0   0   0   0   0          0 0

Penanganan Data hilang dengan menggunakan nilai rata- rata sebagai pengganti.

Split Data

Split data merupakan suatu proses yang membagi data menjadi dua bagian yaitu data train dan data test. Dimana, Train data digunakan sebagai membangun model sedangkan data test di gunakan untuk mengukur kebaikan model. Proses ini menggunakan rasion 0.75 untuk data training dan 0.25 untuk data testing.

set.seed(102)
index <- createDataPartition(newdata$Risk.Level, p=0.75,list=FALSE) 
train <- newdata[ index,] 
test <- newdata[-index,]

Random Forest Classification

Metode Klasifikasi Supervised machine learning yang digunakan adalah metode Random forest. Random forest merupaka suatu model klasifikasi yang berbasik pohon keputusan. Metode ini mengkombinaasikan beberapa pohon-pohon keputusan yang baik untuk dijadikan suatu model.

Cross Validation digunakan sebagai tuning parameter utuk mendapatkan model yang ortimum. Metode Cross Validation yang digunakan adalah K-fold validation dengan K = 10.

set.seed(234)
control = trainControl(
   method = "cv",
   number = 10,
   savePredictions = "final",
   classProbs = TRUE, 
   summaryFunction = twoClassSummary)

set.seed(012)

forest <- train(Risk.Level~ ., 
   data = train, 
   method = "ranger",
   metric = "ROC",
   importance = 'permutation',
   trControl = control)

print(forest)
## Random Forest 
## 
## 88 samples
## 14 predictors
##  2 classes: 'high', 'low' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 79, 80, 79, 79, 80, 79, ... 
## Resampling results across tuning parameters:
## 
##   mtry  splitrule   ROC      Sens  Spec 
##    2    gini        0.91000  0.85  0.850
##    2    extratrees  0.93000  0.87  0.850
##    8    gini        0.92000  0.85  0.850
##    8    extratrees  0.93625  0.85  0.800
##   14    gini        0.91500  0.85  0.850
##   14    extratrees  0.93125  0.85  0.875
## 
## Tuning parameter 'min.node.size' was held constant at a value of 1
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were mtry = 8, splitrule = extratrees
##  and min.node.size = 1.

Berdasarkan hasil dari tuning parameter didapatkan ahwa model terbaik berada ada mtry = 8, splitrule = extratrees dan min.node.size = 1 dengan nilai ROC 0.936 dan nilai sensitifitas dan specifitas yang berada pada nilai 0.85 dan 0.8.

predforest = predict(forest, test, type = "raw")
p_predforest = predict(forest,test,type="prob")
actualforest = factor(test$Risk.Level)

cm_forest <- confusionMatrix(actualforest, predforest,positive = "low")
cm_forest
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction high low
##       high   15   1
##       low     2  11
##                                           
##                Accuracy : 0.8966          
##                  95% CI : (0.7265, 0.9781)
##     No Information Rate : 0.5862          
##     P-Value [Acc > NIR] : 0.0002832       
##                                           
##                   Kappa : 0.7893          
##                                           
##  Mcnemar's Test P-Value : 1.0000000       
##                                           
##             Sensitivity : 0.9167          
##             Specificity : 0.8824          
##          Pos Pred Value : 0.8462          
##          Neg Pred Value : 0.9375          
##              Prevalence : 0.4138          
##          Detection Rate : 0.3793          
##    Detection Prevalence : 0.4483          
##       Balanced Accuracy : 0.8995          
##                                           
##        'Positive' Class : low             
##

Hasil prediksii berdasarkan data testing didapatkan bahwa sebanyak 15 Negara yang memiliki resiko investasi yang tinggi berhasil dikelompokan dengan benar dan sebanyak 11 negara yang memiliki tingkat resiko investasi yang rendah berhasil dikelompokan dan hanya 2 negara saja yang beresiko tinggi di kelompokan sebagai resiko rendah. Didapatkan juga hasil akurasi 0.8966 relatif sangat bagus, dengan sensitivity 0.9167 dan specificity sebesar 0.8824.

vip(forest,aesthetics = list(fill = "blue3")) + 
   ggtitle("Random Forest") +
   theme_minimal()

Variabel yang berpengaruh berdassarkan model Random Forest dengan skala yang terbaik adalah 100 secara berurutan yaitu :

  • X2 : Produk Domestik Bruto per kapita (USD)
  • X14 : % Rata-rata tingkat pengangguran 5 tahun terakhir
  • X10 : Nominal PDB (US miliar)
  • X9 : % Rata-rata Utang Luar Negeri Bersih 5 tahun terakhir
  • X13 : % Rata-rata tabungan domestik bruto terhadap PDB 5 tahun terakhir
  • X4 : % Rata-rata pertumbuhan harga konsumen 5 tahun terakhir
  • X11 : % Rata-rata kredit bermasalah 5 tahun terakhir
  • X5 : % Rata-rata pertumbuhan penduduk 5 tahun terakhir
  • X3 : % Rata-rata Utang Luar Negeri Bruto 5 tahun terakhir
  • X12 : % Rata-rata investasi domestik bruto terhadap PDB 5 tahun terakhir
rocforest = roc(test$Risk.Level, p_predforest[,"low"])
## Setting levels: control = high, case = low
## Setting direction: controls < cases
ggroc(rocforest,linetype = "dashed", size = 1,color="blue3")+
   geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1), color="darkgrey", linetype="dashed")

rocforest$auc
## Area under the curve: 0.9327

Nilai AUC area under curva juga dapat dijadikan sebagai standar nilai keaikan. Dimana, pada model ini didapatkan nilai AUC sangat baik yaitu 0.9327

Kesimpulan

Berdasarkan pemodelan klasifikasi menggunakan Random sampling menggunakan proporsi split data 0.75 untuk data training dan Tuning parameter 10-fold validation didapatkan bahwa mtry terbaik berada pada 8 yang memiliki tingkat keakuran prediksi yang sangat baik sebesar 0.8966.

Metode Random forest ini juga dapat menampilkan variabel yang berpengaruh terhadap model secara berurutan adalah :

  • X2 : Produk Domestik Bruto per kapita (USD)
  • X14 : % Rata-rata tingkat pengangguran 5 tahun terakhir
  • X10 : Nominal PDB (US miliar)
  • X9 : % Rata-rata Utang Luar Negeri Bersih 5 tahun terakhir
  • X13 : % Rata-rata tabungan domestik bruto terhadap PDB 5 tahun terakhir
  • X4 : % Rata-rata pertumbuhan harga konsumen 5 tahun terakhir
  • X11 : % Rata-rata kredit bermasalah 5 tahun terakhir
  • X5 : % Rata-rata pertumbuhan penduduk 5 tahun terakhir
  • X3 : % Rata-rata Utang Luar Negeri Bruto 5 tahun terakhir
  • X12 : % Rata-rata investasi domestik bruto terhadap PDB 5 tahun terakhir