Membaca Data

Membaca data dari file excel ke dalam R dilakukan dengan perintah sebagai berikut

data1 <- readxl::read_xlsx("investment_risk_level.xlsx", sheet = 'investment')
data1

## # A tibble: 117 x 16
##    Country    X1     X2    X3    X4    X5     X6      X7    X8     X9     X10
##    <chr>   <dbl>  <dbl> <dbl> <dbl> <dbl>  <dbl>   <dbl> <dbl>  <dbl>   <dbl>
##  1 AD       17.5 38675. 173.   0.68 1.22   1.79  -2.08    55   -26.5     2.86
##  2 AE       18.2 40105. 104.   1.77 0.870  2.66  -0.725  103.  -13.6   353.  
##  3 AE-AZ    18.7 76038.  31.0  2.63 1.49   1.85  -1.90   103.  -56.2   200.  
##  4 AE-RK    NA   27883.  24.8  1.29 1.75   2.23  -1.14   103.   24.8    10.1 
##  5 AM       14    4251.  89.6  1.44 0.256  4.75   2.33   167.   47.3    12.6 
##  6 AO       NA    2034.  57.1 22.4  3.34  -0.878 -5.20    34.8  15.4    62.5 
##  7 AR       23.3  9203.  43.3 36.7  0.966 -0.237 -3.73    NA    -5.01  375.  
##  8 AT       18.6 53174. 159.   1.52 0.726  1.88  -0.300  116.   15.4   430.  
##  9 AU       15.7 63972. 122.   1.65 1.48   2.45   0.0306 192.   58.0  1359.  
## 10 AW       33.5 24643.  92.8  1.22 0.797  2.06  -4.72    80.5  28.1     2.38
## # ... with 107 more rows, and 5 more variables: X11 <dbl>, X12 <dbl>,
## #   X13 <dbl>, X14 <dbl>, Risk Level <chr>

Deskripsi Data

Berikut adalah penjelasan setiap variabel dalam dataset di atas

Untuk keperluan analisis, dilakukan beberapa hal sebagai berikut:

• Mengubah tipe data peubah response Risk Level menjadi bertipe factor

• Optional: mengubah nama kolom Risk Level menjadi risk_level

# mengubah tipe data peubah
data1$`Risk Level` <- as.factor(data1$`Risk Level`)

colnames(data1)[16] <- "risk_level"

library(rmarkdown)
paged_table(data1)

Ringkasan Data

# library(skimr)
skim(data1)

Variable type: character

Variable type: factor

Variable type: numeric

Data investment risk level (pada analisi ini disimpai dalam objek data1) terdiri atas 16 peubah dan 117 observasi. Dari 16 peubah tersebut, terdapat 1 peubah karakter (kolom Country), 14 peubah numerik (kolom X1 s.d X14) sebagai peubah prediktor, dan 1 peubah kategorik (kolom risk_level) dengan dua kelas sebagai peubah respon.

Pada data di atas, terdapat missing value di beberapa peubah prediktor, yaitu peubah X1 sejumlah 13 data, X8 sejumlah 9 data, X11 sejumlah 21 data, dan X14 sejumlah 12 data. Agar proses pemodelan dapat dilakukan, peru dilakukan penanganan terhadap kasus missing value tersebut.

Penanganan Missing Value

Penanganan dilakukan dengan mengisi data kosong dengan rataan nilai dari masing-masing kolom/peubah

# peubah X1
data1$X1 <- ifelse(is.na(data1$X1),
                   ave(data1$X1, FUN = function(x) mean(x, na.rm = TRUE)),
                   data1$X1)

# peubah X8
data1$X8 <- ifelse(is.na(data1$X8),
                   ave(data1$X8, FUN = function(x) mean(x, na.rm = TRUE)),
                   data1$X8)

# peubah X11
data1$X11 <- ifelse(is.na(data1$X11),
                   ave(data1$X11, FUN = function(x) mean(x, na.rm = TRUE)),
                   data1$X11)

# peubah X14
data1$X14 <- ifelse(is.na(data1$X14),
                   ave(data1$X14, FUN = function(x) mean(x, na.rm = TRUE)),
                   data1$X14)

skim(data1)

Variable type: character

Variable type: factor

Variable type: numeric

# data setelah dilakukan penanganan missing value
paged_table(data1)

Proporsi dua kelas dalam peubah respon

prop.table(table(data1$risk_level))

## 
##      high       low 
## 0.5470085 0.4529915

Berdasarkan statistik deskriptif di atas dapat diketahui bahwa peubah respon memiliki anggota kelas High risk level sebanyak 54.7% dan kelas Low risk level sebanyak 45.29% pengamatan.

Sebaran Data

Untuk melihat sebaran data setiap peubah, setiap peubah digambarkan dalam bentuk box-plot.

library(caret)

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following object is masked from 'package:purrr':
## 
##     lift

featurePlot(x = data1[, 2:15], 
            y = data1$risk_level, 
            plot = "box",
            do.out = FALSE,
            layout = c(5,3),
            strip = strip.custom(par.strip.text=list(cex=.7)),
            scales = list(x = list(relation="free"), 
                          y = list(relation="free")))

featurePlot(x = data1[, 2:15], 
            y = data1$risk_level, 
            plot = "density",
            do.out = FALSE,
            layout = c(5,3),
            strip = strip.custom(par.strip.text=list(cex=.7)),
            scales = list(x = list(relation="free"), 
                          y = list(relation="free")))

Dari box-plot dan density plot di atas, terlihat bahwa banyak peubah predictor yang sebaran datanya tidak simetris dan terdapat cukup banyak outlier.

Split Data

Melakukan pembagian dataset menjadi data train dan data testing sebagai metode untuk melatih dan mengevaluasi performa model machine learning. Data training digunakan untuk membuat model, sedangkan data testing digunakan untuk evaluasi kebaikan model.

set.seed(100)

# Mengambil amatan yang digunakan sebagai data train
train_index <- createDataPartition(data1$risk_level, p = 0.8, list = FALSE)
train_index    # index amatan 

##       Resample1
##  [1,]         2
##  [2,]         3
##  [3,]         4
##  [4,]         5
##  [5,]         6
##  [6,]         8
##  [7,]        10
##  [8,]        12
##  [9,]        13
## [10,]        14
## [11,]        15
## [12,]        16
## [13,]        17
## [14,]        18
## [15,]        19
## [16,]        20
## [17,]        21
## [18,]        22
## [19,]        23
## [20,]        24
## [21,]        25
## [22,]        26
## [23,]        28
## [24,]        30
## [25,]        32
## [26,]        33
## [27,]        35
## [28,]        36
## [29,]        37
## [30,]        38
## [31,]        39
## [32,]        40
## [33,]        42
## [34,]        43
## [35,]        44
## [36,]        45
## [37,]        46
## [38,]        47
## [39,]        48
## [40,]        49
## [41,]        50
## [42,]        51
## [43,]        52
## [44,]        53
## [45,]        54
## [46,]        55
## [47,]        56
## [48,]        58
## [49,]        59
## [50,]        60
## [51,]        61
## [52,]        62
## [53,]        63
## [54,]        64
## [55,]        65
## [56,]        66
## [57,]        68
## [58,]        69
## [59,]        70
## [60,]        71
## [61,]        72
## [62,]        73
## [63,]        75
## [64,]        76
## [65,]        78
## [66,]        79
## [67,]        80
## [68,]        82
## [69,]        84
## [70,]        85
## [71,]        87
## [72,]        89
## [73,]        90
## [74,]        91
## [75,]        92
## [76,]        95
## [77,]        96
## [78,]        97
## [79,]        98
## [80,]        99
## [81,]       100
## [82,]       101
## [83,]       103
## [84,]       104
## [85,]       105
## [86,]       106
## [87,]       107
## [88,]       108
## [89,]       109
## [90,]       110
## [91,]       111
## [92,]       112
## [93,]       114
## [94,]       115
## [95,]       116

# Data train
train_data <- data1[train_index,]
head(train_data)

## # A tibble: 6 x 16
##   Country    X1     X2    X3    X4    X5     X6     X7    X8    X9   X10   X11
##   <chr>   <dbl>  <dbl> <dbl> <dbl> <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AE       18.2 40105. 104.   1.77 0.870  2.66  -0.725 103.  -13.6 353.   8.15
## 2 AE-AZ    18.7 76038.  31.0  2.63 1.49   1.85  -1.90  103.  -56.2 200.   8.15
## 3 AE-RK    18.7 27883.  24.8  1.29 1.75   2.23  -1.14  103.   24.8  10.1  6.31
## 4 AM       14    4251.  89.6  1.44 0.256  4.75   2.33  167.   47.3  12.6  6.6 
## 5 AO       18.7  2034.  57.1 22.4  3.34  -0.878 -5.20   34.8  15.4  62.5 10.3 
## 6 AT       18.6 53174. 159.   1.52 0.726  1.88  -0.300 116.   15.4 430.   2.02
## # ... with 4 more variables: X12 <dbl>, X13 <dbl>, X14 <dbl>, risk_level <fct>

# Data testing
test_data <- data1[-train_index,]
head(test_data)

## # A tibble: 6 x 16
##   Country    X1     X2    X3     X4    X5     X6      X7    X8      X9     X10
##   <chr>   <dbl>  <dbl> <dbl>  <dbl> <dbl>  <dbl>   <dbl> <dbl>   <dbl>   <dbl>
## 1 AD       17.5 38675. 173.   0.68  1.22   1.79  -2.08    55    -26.5     2.86
## 2 AR       23.3  9203.  43.3 36.7   0.966 -0.237 -3.73    99.5   -5.01  375.  
## 3 AU       15.7 63972. 122.   1.65  1.48   2.45   0.0306 192.    58.0  1359.  
## 4 AZ       25.3  5083.  43.4  6.85  1.05   0.391 -1.74   111.  -174.     42.6 
## 5 CO       17.2  5860.  47.6  4.71  1.38   2.45  -0.888  117.     9.93  271.  
## 6 CV       19.4  3466. 115.   0.379 1.16   3.92  -0.404   67.5   51.4     1.70
## # ... with 5 more variables: X11 <dbl>, X12 <dbl>, X13 <dbl>, X14 <dbl>,
## #   risk_level <fct>

Dalam proses pemodelan, kolom Country tidak digunakan sehingga dihapus dari data training dan data testing.

train_data$Country <- NULL
test_data$Country <- NULL

Standarisasi Data

Tahapan selanjutnya adalah standarisasi. Standarisasi dilakukan karena skala dari setiap peubah prediktor berbeda-beda, sedangkan untuk hasil pemodelan yang baik diperlukan skala yang sama. Metode standarisasi yang digunakan adalah transformasi ke normal baku (Z).

standardize <- preProcess(train_data, method = c("center", "scale"))

train_data_s <- predict(standardize, newdata = train_data)

test_data_s <- predict(standardize, newdata = test_data)

Cross validation

Cross Validation (CV) merupakan metode untuk mengukur kinerja model. Pada studi kasus ini tipe CV yang digunakan adalah repeatedcv k-folds (validasi silang k-folds berulang) dengan folds yang digunakan adalah 5 folds dan perulangan dilakukan sebanyak 5 kali. Data dipartisi secara acak ke dalam lipatan/subset data (folds). Untuk masing-masing subset data tersebut, CV akan menggunakan empat folds untuk training dan satu fold untuk testing.

Cross Validation dalam studi kasus ini digunakan untuk tuning parameter, yakni mencari parameter terbaik bagi model yang memberikan nilai kebaikan evaluasi optimal.

fit_Control <- trainControl(method = 'repeatedcv',
                            number = 5,
                            repeats = 5,
                            savePredictions = 'final',
                            classProbs = T,
                            summaryFunction = prSummary,
                            allowParallel = TRUE)

Metriks evaluasi yang ditampilkan meliputi precision, recall dan F1-score. Pada kasus ini metrik yang digunakan adalah F1-score di mana nilai terbaiknya adalah 1 dan nilai terburuknya adalah 0. F1-score yang baik mengindikasikan bahwa model klasifikasi yang dihasilan memiliki nilai precision dan recall yang baik.

Fitting Model

set.seed(100)

# library(ModelMetrics)
rf <- train(risk_level ~., data = train_data_s,
            method = 'ranger',
            metric = "F",
            tuneLength = 10,
            trControl = fit_Control, 
            importance = 'impurity')
rf

## Random Forest 
## 
## 95 samples
## 14 predictors
##  2 classes: 'high', 'low' 
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 5 times) 
## Summary of sample sizes: 76, 76, 76, 76, 76, 75, ... 
## Resampling results across tuning parameters:
## 
##   mtry  splitrule   AUC        Precision  Recall     F        
##    2    gini        0.8733406  0.8804966  0.8818182  0.8727286
##    2    extratrees  0.8697731  0.8754178  0.8701818  0.8660647
##    3    gini        0.8726069  0.8852483  0.8661818  0.8691898
##    3    extratrees  0.8656059  0.8842343  0.8705455  0.8702183
##    4    gini        0.8705316  0.8837518  0.8545455  0.8626873
##    4    extratrees  0.8654105  0.8871854  0.8705455  0.8716585
##    6    gini        0.8640966  0.8932266  0.8429091  0.8597012
##    6    extratrees  0.8635803  0.8990155  0.8665455  0.8759484
##    7    gini        0.8633970  0.9087215  0.8469091  0.8688785
##    7    extratrees  0.8574909  0.8856822  0.8665455  0.8688762
##    8    gini        0.8582331  0.9126946  0.8509091  0.8730173
##    8    extratrees  0.8612042  0.8982603  0.8705455  0.8779944
##   10    gini        0.8577532  0.8973440  0.8436364  0.8623278
##   10    extratrees  0.8619580  0.9040785  0.8625455  0.8767615
##   11    gini        0.8501395  0.9066571  0.8396364  0.8650164
##   11    extratrees  0.8596047  0.8904747  0.8669091  0.8726571
##   12    gini        0.8503759  0.9030938  0.8432727  0.8658341
##   12    extratrees  0.8609997  0.8996061  0.8589091  0.8730065
##   14    gini        0.8471561  0.9056268  0.8316364  0.8600780
##   14    extratrees  0.8600832  0.8958765  0.8621818  0.8727337
## 
## Tuning parameter 'min.node.size' was held constant at a value of 1
## F 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.

Dari hasil output di atas, hasil tunning parameter dengan k-fold cv berulang pada model random forest memberikan AUC (luas area di bawah kurva ROC), precision, recall dan F1-score yang tinggi (>80%), sehingga dapat dikatakan bahwa model random forest yang dibangun cukup baik. Model final diperoleh dengan parameter mtry = 8, splitrule = extratress dan min.node.size = 1.

Variabel Importance

Berikut dapat diketahui ukuran tingkat kepentingan peubah prediktor yang relevan terhadap peubah respons

plot(varImp(rf, scale = FALSE))

Dari output di atas dapat diketahui bahwa Gross Domestic Product per kapita (X2) merupakan variabel terpenting bagi model random forest. Selanjutnya disusul oleh X13: rataan tabungan domestik bruto terhadap GDP; X14: tingkat pengangguran; dan X11: rataan kredit bermasalah, di mana termasuk variabel terpenting teratas bagi model ini.

Prediksi

testing_pred <- predict(rf, newdata = test_data_s)
  
confusionMatrix(testing_pred, test_data_s$risk_level)

## 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            
## 

Berdasarkan hasil uji coba model random forest pada data testing, ditunjukkan bahwa kelas positive yang dimaksud adalah kelompok negara dengan tingkat risiko investasi tinggi (high risk level).

Interpretasi prediksi

• Tingkat akurasi menggambarkan tingkat ketepatan model dalam mengklasifikasikan dengan benar. Dalam kasus ini berarti bahwa model dapat memprediksi benar negara tergolong high risk atau low risk sebesar 86.36%

• Spesificity/precision/positive predictive value menggambarkan ketepatan antara data yang diminta terhadap hasil prediksi yang diberikan model. Pada kasus ini, berarti bahwa negara yang benar termasuk negara high risk dari keseluruhan negara yang diprediksi sebagai negara high risk sebesar 90%

• Sensitivity/recall menggambarkan keberhasilan model dalam menemukan informasi. Pada kasus ini, berarti bahwa negara yang diprediksi sebagai negara high risk dibanding keseluruhan negara yang sebenarnya termasuk dalam high risk sebesar 83.33%

Kesimpulan

Berdasarkan proses di atas, model random forest final untuk memprediksi tingkat risiko investasi negara memberikan nilai akurasi 86.36%. Model tersebut mengelompokan kelas positif sebagai negara dengan high risk level atau negara yang memiliki risiko tinggi dalam hal investasi.

Berdasarkan nilai variable importance, peubah-peubah prediktor dapat diurutikan dari yang terpenting (bagi pembangunan model) sebagai berikut:

• X2 : Gross per capita (USD)

• X13 : Percentage of gross domestic saving to GDP (%) average from last 5 years

• X11 : Non-performing loans (% of gross loans) average from last 5 years

• X14 : Unemployment rate (% labour force) average from last 5 years

• X10 : Nominal GDP (USD bn)

• X4 : Growth of consumer price (%) average from last 5 years

• X9 : Net External Debt (% of GDP) average from last 5 years

• X5 : Growth of population (%) average from last 5 years

• X1 : Capital adequacy ratio (%) average from last 5 years

• X12 : Percentage of gross domestic investment to 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

• X6 : Growth of Real GDP (%) average from last 5 years

• X3 : Gross External Debt (% of GDP) average from last 5 years