1 Mengaktifkan Package

Beberapa package yang digunakan dalam analisis data ini adalah sebagai berikut.

library(readxl)
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidymodels)

## ── Attaching packages ────────────────────────────────────── tidymodels 1.1.1 ──
## ✔ broom        1.0.5     ✔ rsample      1.2.0
## ✔ dials        1.2.0     ✔ tune         1.1.2
## ✔ infer        1.0.5     ✔ workflows    1.1.3
## ✔ modeldata    1.2.0     ✔ workflowsets 1.0.1
## ✔ parsnip      1.1.1     ✔ yardstick    1.2.0
## ✔ recipes      1.0.8     
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter()   masks stats::filter()
## ✖ recipes::fixed()  masks stringr::fixed()
## ✖ dplyr::lag()      masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step()   masks stats::step()
## • Use suppressPackageStartupMessages() to eliminate package startup messages

library(dplyr)
library(DataExplorer)
library(skimr)
library(themis)
library(tictoc)
library(xgboost)

## 
## Attaching package: 'xgboost'
## 
## The following object is masked from 'package:dplyr':
## 
##     slice

2 Import Data

Data yang digunakan berasal dari Kaggle yaitu Loan-Approval-Prediction-Dataset. Import data dilakukan menggunakan read.csv karena data yang digunakan berada dalam format csv.

dataku <- read.csv("D:/S2 STATISTIKA/SEMESTER 2/PEMBELAJARAN MESIN STATISTIKA/loan_approval_dataset.csv")
head(dataku)

##   loan_id no_of_dependents     education self_employed income_annum loan_amount
## 1       1                2      Graduate            No      9600000    29900000
## 2       2                0  Not Graduate           Yes      4100000    12200000
## 3       3                3      Graduate            No      9100000    29700000
## 4       4                3      Graduate            No      8200000    30700000
## 5       5                5  Not Graduate           Yes      9800000    24200000
## 6       6                0      Graduate           Yes      4800000    13500000
##   loan_term cibil_score residential_assets_value commercial_assets_value
## 1        12         778                  2400000                17600000
## 2         8         417                  2700000                 2200000
## 3        20         506                  7100000                 4500000
## 4         8         467                 18200000                 3300000
## 5        20         382                 12400000                 8200000
## 6        10         319                  6800000                 8300000
##   luxury_assets_value bank_asset_value loan_status
## 1            22700000          8000000    Approved
## 2             8800000          3300000    Rejected
## 3            33300000         12800000    Rejected
## 4            23300000          7900000    Rejected
## 5            29400000          5000000    Rejected
## 6            13700000          5100000    Rejected

glimpse(dataku)

## Rows: 4,269
## Columns: 13
## $ loan_id                  <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14…
## $ no_of_dependents         <int> 2, 0, 3, 3, 5, 0, 5, 2, 0, 5, 4, 2, 3, 2, 1, …
## $ education                <chr> " Graduate", " Not Graduate", " Graduate", " …
## $ self_employed            <chr> " No", " Yes", " No", " No", " Yes", " Yes", …
## $ income_annum             <int> 9600000, 4100000, 9100000, 8200000, 9800000, …
## $ loan_amount              <int> 29900000, 12200000, 29700000, 30700000, 24200…
## $ loan_term                <int> 12, 8, 20, 8, 20, 10, 4, 20, 20, 10, 2, 18, 1…
## $ cibil_score              <int> 778, 417, 506, 467, 382, 319, 678, 382, 782, …
## $ residential_assets_value <int> 2400000, 2700000, 7100000, 18200000, 12400000…
## $ commercial_assets_value  <int> 17600000, 2200000, 4500000, 3300000, 8200000,…
## $ luxury_assets_value      <int> 22700000, 8800000, 33300000, 23300000, 294000…
## $ bank_asset_value         <int> 8000000, 3300000, 12800000, 7900000, 5000000,…
## $ loan_status              <chr> " Approved", " Rejected", " Rejected", " Reje…

Setelah dilakukan import data, dilakukan langkah untuk menghilangkan kolom loan_id yang terdapat pada data.

dataku <- dataku[,-1]
glimpse(dataku)

## Rows: 4,269
## Columns: 12
## $ no_of_dependents         <int> 2, 0, 3, 3, 5, 0, 5, 2, 0, 5, 4, 2, 3, 2, 1, …
## $ education                <chr> " Graduate", " Not Graduate", " Graduate", " …
## $ self_employed            <chr> " No", " Yes", " No", " No", " Yes", " Yes", …
## $ income_annum             <int> 9600000, 4100000, 9100000, 8200000, 9800000, …
## $ loan_amount              <int> 29900000, 12200000, 29700000, 30700000, 24200…
## $ loan_term                <int> 12, 8, 20, 8, 20, 10, 4, 20, 20, 10, 2, 18, 1…
## $ cibil_score              <int> 778, 417, 506, 467, 382, 319, 678, 382, 782, …
## $ residential_assets_value <int> 2400000, 2700000, 7100000, 18200000, 12400000…
## $ commercial_assets_value  <int> 17600000, 2200000, 4500000, 3300000, 8200000,…
## $ luxury_assets_value      <int> 22700000, 8800000, 33300000, 23300000, 294000…
## $ bank_asset_value         <int> 8000000, 3300000, 12800000, 7900000, 5000000,…
## $ loan_status              <chr> " Approved", " Rejected", " Rejected", " Reje…

str(dataku)

## 'data.frame':    4269 obs. of  12 variables:
##  $ no_of_dependents        : int  2 0 3 3 5 0 5 2 0 5 ...
##  $ education               : chr  " Graduate" " Not Graduate" " Graduate" " Graduate" ...
##  $ self_employed           : chr  " No" " Yes" " No" " No" ...
##  $ income_annum            : int  9600000 4100000 9100000 8200000 9800000 4800000 8700000 5700000 800000 1100000 ...
##  $ loan_amount             : int  29900000 12200000 29700000 30700000 24200000 13500000 33000000 15000000 2200000 4300000 ...
##  $ loan_term               : int  12 8 20 8 20 10 4 20 20 10 ...
##  $ cibil_score             : int  778 417 506 467 382 319 678 382 782 388 ...
##  $ residential_assets_value: int  2400000 2700000 7100000 18200000 12400000 6800000 22500000 13200000 1300000 3200000 ...
##  $ commercial_assets_value : int  17600000 2200000 4500000 3300000 8200000 8300000 14800000 5700000 800000 1400000 ...
##  $ luxury_assets_value     : int  22700000 8800000 33300000 23300000 29400000 13700000 29200000 11800000 2800000 3300000 ...
##  $ bank_asset_value        : int  8000000 3300000 12800000 7900000 5000000 5100000 4300000 6000000 600000 1600000 ...
##  $ loan_status             : chr  " Approved" " Rejected" " Rejected" " Rejected" ...

Berdasarkan output tersebut, terlihat bahwa peubah education, self_employed dan loan_status bertipe karakter padahal peubah peubah tersebut merupakan peubah kategorik yang seharusnya bertipe factor sehingga dalam hal ini akan dilakukan penyesuaian tipe peubah.

dataku$education <- as.factor(dataku$education)
dataku$self_employed <- as.factor(dataku$self_employed)
dataku$loan_status <- as.factor(dataku$loan_status)

str(dataku)

## 'data.frame':    4269 obs. of  12 variables:
##  $ no_of_dependents        : int  2 0 3 3 5 0 5 2 0 5 ...
##  $ education               : Factor w/ 2 levels " Graduate"," Not Graduate": 1 2 1 1 2 1 1 1 1 2 ...
##  $ self_employed           : Factor w/ 2 levels " No"," Yes": 1 2 1 1 2 2 1 2 2 1 ...
##  $ income_annum            : int  9600000 4100000 9100000 8200000 9800000 4800000 8700000 5700000 800000 1100000 ...
##  $ loan_amount             : int  29900000 12200000 29700000 30700000 24200000 13500000 33000000 15000000 2200000 4300000 ...
##  $ loan_term               : int  12 8 20 8 20 10 4 20 20 10 ...
##  $ cibil_score             : int  778 417 506 467 382 319 678 382 782 388 ...
##  $ residential_assets_value: int  2400000 2700000 7100000 18200000 12400000 6800000 22500000 13200000 1300000 3200000 ...
##  $ commercial_assets_value : int  17600000 2200000 4500000 3300000 8200000 8300000 14800000 5700000 800000 1400000 ...
##  $ luxury_assets_value     : int  22700000 8800000 33300000 23300000 29400000 13700000 29200000 11800000 2800000 3300000 ...
##  $ bank_asset_value        : int  8000000 3300000 12800000 7900000 5000000 5100000 4300000 6000000 600000 1600000 ...
##  $ loan_status             : Factor w/ 2 levels " Approved"," Rejected": 1 2 2 2 2 2 1 2 1 2 ...

3 Cek Missing Value

colSums(is.na(dataku))

##         no_of_dependents                education            self_employed 
##                        0                        0                        0 
##             income_annum              loan_amount                loan_term 
##                        0                        0                        0 
##              cibil_score residential_assets_value  commercial_assets_value 
##                        0                        0                        0 
##      luxury_assets_value         bank_asset_value              loan_status 
##                        0                        0                        0

plot_intro(data = dataku,
           geom_label_args = list(size=2.5))

4 Cek Data Duplikat

sum(duplicated(dataku))

## [1] 0

Berdasarkan output tersebut, diperoleh bahwa tidak terdapat missing value dan data duplikat pada data.

skim_without_charts(data = dataku)

Data summary
Name	dataku
Number of rows	4269
Number of columns	12
_______________________
Column type frequency:
factor	3
numeric	9
________________________
Group variables	None

Variable type: factor

skim_variable	complete_rate	ordered	n_unique	top_counts
education	1	FALSE	2	Gr: 2144, No: 2125
self_employed	1	FALSE	2	Ye: 2150, No: 2119
loan_status	1	FALSE	2	Ap: 2656, Re: 1613

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100
no_of_dependents	1	2.50	1.70	0e+00	1	3	4	5
income_annum	1	5059123.92	2806839.83	2e+05	2700000	5100000	7500000	9900000
loan_amount	1	15133450.46	9043362.98	3e+05	7700000	14500000	21500000	39500000
loan_term	1	10.90	5.71	2e+00	6	10	16	20
cibil_score	1	599.94	172.43	3e+02	453	600	748	900
residential_assets_value	1	7472616.54	6503636.59	-1e+05	2200000	5600000	11300000	29100000
commercial_assets_value	1	4973155.31	4388966.09	0e+00	1300000	3700000	7600000	19400000
luxury_assets_value	1	15126305.93	9103753.67	3e+05	7500000	14600000	21700000	39200000
bank_asset_value	1	4976692.43	3250185.31	0e+00	2300000	4600000	7100000	14700000

5 Eksplorasi Data

Adapun ringkasan dari data adalah sebagai berikut.

summary(dataku)

##  no_of_dependents         education    self_employed  income_annum    
##  Min.   :0.000     Graduate    :2144    No :2119     Min.   : 200000  
##  1st Qu.:1.000     Not Graduate:2125    Yes:2150     1st Qu.:2700000  
##  Median :3.000                                       Median :5100000  
##  Mean   :2.499                                       Mean   :5059124  
##  3rd Qu.:4.000                                       3rd Qu.:7500000  
##  Max.   :5.000                                       Max.   :9900000  
##   loan_amount         loan_term     cibil_score    residential_assets_value
##  Min.   :  300000   Min.   : 2.0   Min.   :300.0   Min.   : -100000        
##  1st Qu.: 7700000   1st Qu.: 6.0   1st Qu.:453.0   1st Qu.: 2200000        
##  Median :14500000   Median :10.0   Median :600.0   Median : 5600000        
##  Mean   :15133450   Mean   :10.9   Mean   :599.9   Mean   : 7472617        
##  3rd Qu.:21500000   3rd Qu.:16.0   3rd Qu.:748.0   3rd Qu.:11300000        
##  Max.   :39500000   Max.   :20.0   Max.   :900.0   Max.   :29100000        
##  commercial_assets_value luxury_assets_value bank_asset_value  
##  Min.   :       0        Min.   :  300000    Min.   :       0  
##  1st Qu.: 1300000        1st Qu.: 7500000    1st Qu.: 2300000  
##  Median : 3700000        Median :14600000    Median : 4600000  
##  Mean   : 4973155        Mean   :15126306    Mean   : 4976692  
##  3rd Qu.: 7600000        3rd Qu.:21700000    3rd Qu.: 7100000  
##  Max.   :19400000        Max.   :39200000    Max.   :14700000  
##     loan_status  
##   Approved:2656  
##   Rejected:1613  
##                  
##                  
##                  
##

5.1 Eksploarasi Peubah Respon

Melakukan visualisasi peubah Y menggunakan piechart untuk melihat banyaknya peminjam yang berpotensi menerima pinjaman dan ditolak.

dataku %>% 
count(loan_status) %>% 
mutate(percent=n*100/sum(n),label=str_c(round(percent,2),"%")) %>% 
ggplot(aes(x="",y=n,fill=loan_status))+
  geom_col()+
  geom_text(aes(label = label),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y")+
  theme_void() +
  labs(title = "Proporsi Loan Status",
       fill = "Loan Status")

Berdasarkan piechart tersebut terlihat bahwa banyaknya peminjam yang berpotensi menerima pinjaman jauh lebih banyak dibandingkan dengan peminjam yang berpotensi ditolak untuk menerima pinjaman. Hal ini menunjukkan adanya proporsi data yang tidak seimbang sehingga perlu dilakukan penanganan pada tahapan praproses data.

5.2 Eksplorasi Secara Numerik

skim_without_charts(dataku)

Data summary
Name	dataku
Number of rows	4269
Number of columns	12
_______________________
Column type frequency:
factor	3
numeric	9
________________________
Group variables	None

Variable type: factor

skim_variable	complete_rate	ordered	n_unique	top_counts
education	1	FALSE	2	Gr: 2144, No: 2125
self_employed	1	FALSE	2	Ye: 2150, No: 2119
loan_status	1	FALSE	2	Ap: 2656, Re: 1613

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100
no_of_dependents	1	2.50	1.70	0e+00	1	3	4	5
income_annum	1	5059123.92	2806839.83	2e+05	2700000	5100000	7500000	9900000
loan_amount	1	15133450.46	9043362.98	3e+05	7700000	14500000	21500000	39500000
loan_term	1	10.90	5.71	2e+00	6	10	16	20
cibil_score	1	599.94	172.43	3e+02	453	600	748	900
residential_assets_value	1	7472616.54	6503636.59	-1e+05	2200000	5600000	11300000	29100000
commercial_assets_value	1	4973155.31	4388966.09	0e+00	1300000	3700000	7600000	19400000
luxury_assets_value	1	15126305.93	9103753.67	3e+05	7500000	14600000	21700000	39200000
bank_asset_value	1	4976692.43	3250185.31	0e+00	2300000	4600000	7100000	14700000

5.3 Eksplorasi Hubungan Penjelas Kategorik dengan Respon

plot_bar(data = dataku,by = "loan_status",
         ggtheme = theme_classic(),
         ncol = 2)

Dari peubah penjelas kategorik yang terdiri dari education dan self_employed. Pada peubah education menunjukkan bahwa proporsi status pinjaman diterima untuk graduate dan not graduate lebih besar dibanding ditolak. Sedangkan pada peubah self_employed, juga menunjukkan bahwa proporsi status pinjaman diterima untuk yes dan no lebih besar dibanding ditolak.

5.4 Eksplorasi Hubungan Penjelas Kontinu dengan Respon

plot_boxplot(data = dataku,by = "loan_status",
         ggtheme = theme_classic(),
         geom_boxplot_args = list(fill="#03A9F4"))

Berdasarkan box-plot, terlihat bahwa beberapa peubah memiliki cukup banyak pencilan. Berdasarkan boxplot terlihat pula bahwa terdapat ketidakseragaman skala pada setiap peubah sehingga perlu dilakukan penanganan pada tahapan praproses data. Berdasarkan box-plot tersebut, terlihat secara grafis bahwa ada perbedaan secara rata-rata dan sebaran antara kelompok diterima dan ditolak untuk setiap peubah penjelas.

5.5 Eksploarsi Hubungan antar Penjelas Kontinu

Sebelum dilakukan pemodelan, akan dilakukan pengecekan bagaimana korelasi antar peubah penjelas yang akan digunakan dalam model. Peubah yang digunakan sebaiknya adalah peubah yang tidak saling berkorelasi satu sama lain.

plot_correlation(data = dataku,
                 type = "continuous",
                 cor_args = list(method="spearman"),
                 ggtheme = theme_classic(),
                 theme_config = list(legend.position = "none",
                                     axis.text.x=element_text(angle = 90)))

Berdasarkan heatmap tersebut, diketahui bahwa terdapat beberapa peubah penjelas memiliki nilai korelasi di atas 0.8. Hal ini mengindikasi bahwa terdapat multikolinieritas antar peubah penjelas. Namun korelasi yang tinggi tersebut tidak diatasi karena dengan menggunakan ensemble methods seperti Random Forest atau Gradient Boosting yang lebih tahan terhadap multicollinearity bisa membantu mengurangi dampak dari korelasi yang tinggi.

6 Praproses Data

6.1 Penanganan Outlier dengan IQR

# Fungsi untuk menangani outlier
handle_outliers <- function(dataku, columns) {
  for (col in columns) {
    # Hitung IQR
    Q1 <- quantile(dataku[[col]], 0.25)
    Q3 <- quantile(dataku[[col]], 0.75)
    IQR <- Q3 - Q1
    
    # Tentukan batas untuk outlier
    lower_bound <- Q1 - 1.5 * IQR
    upper_bound <- Q3 + 1.5 * IQR
    
    # Cap outlier
    dataku[[col]] <- ifelse(dataku[[col]] < lower_bound, lower_bound, dataku[[col]])
    dataku[[col]] <- ifelse(dataku[[col]] > upper_bound, upper_bound, dataku[[col]])
  }
  return(dataku)
}

# Kolom yang akan ditangani outliernya
columns <- c('bank_asset_value', 'cibil_score', 'commercial_assets_value', 'income_annum', 
             'loan_amount', 'loan_term', 'luxury_assets_value', 'no_of_dependents', 
             'residential_assets_value')

# Tangani outlier
data <- handle_outliers(dataku, columns)

# Cek hasilnya
print(summary(data))

##  no_of_dependents         education    self_employed  income_annum    
##  Min.   :0.000     Graduate    :2144    No :2119     Min.   : 200000  
##  1st Qu.:1.000     Not Graduate:2125    Yes:2150     1st Qu.:2700000  
##  Median :3.000                                       Median :5100000  
##  Mean   :2.499                                       Mean   :5059124  
##  3rd Qu.:4.000                                       3rd Qu.:7500000  
##  Max.   :5.000                                       Max.   :9900000  
##   loan_amount         loan_term     cibil_score    residential_assets_value
##  Min.   :  300000   Min.   : 2.0   Min.   :300.0   Min.   : -100000        
##  1st Qu.: 7700000   1st Qu.: 6.0   1st Qu.:453.0   1st Qu.: 2200000        
##  Median :14500000   Median :10.0   Median :600.0   Median : 5600000        
##  Mean   :15133450   Mean   :10.9   Mean   :599.9   Mean   : 7454861        
##  3rd Qu.:21500000   3rd Qu.:16.0   3rd Qu.:748.0   3rd Qu.:11300000        
##  Max.   :39500000   Max.   :20.0   Max.   :900.0   Max.   :24950000        
##  commercial_assets_value luxury_assets_value bank_asset_value  
##  Min.   :       0        Min.   :  300000    Min.   :       0  
##  1st Qu.: 1300000        1st Qu.: 7500000    1st Qu.: 2300000  
##  Median : 3700000        Median :14600000    Median : 4600000  
##  Mean   : 4964289        Mean   :15126306    Mean   : 4976341  
##  3rd Qu.: 7600000        3rd Qu.:21700000    3rd Qu.: 7100000  
##  Max.   :17050000        Max.   :39200000    Max.   :14300000  
##     loan_status  
##   Approved:2656  
##   Rejected:1613  
##                  
##                  
##                  
##

plot_boxplot(data = data,by = "loan_status",
         ggtheme = theme_classic(),
         geom_boxplot_args = list(fill="#03A9F4"))

Berdasarkan box-plot, terlihat bahwa beberapa peubah yang sebelumnya memiliki banyak pencilan menunjukkan pengurangan jumlah pencilan.

Berdasarkan eksplorasi data, terlihat bahwa perlu dilakukan penanganan pada kondisi data tidak seimbang. Dalam hal ini, kondisi data tidak seimbang ditangani dengan melakukan SMOTE. Selain itu, berdasarkan eksplorasi data, perlu dilakukan penanganan pada peubah penjelas numerik yang memiliki ketidakseragaman skala, sehingga dalam hal ini ketidakseragaman skala ditangani dengan melakukan proses normalisasi. Lalu juga dilakukan One-hot Encoding untuk semua variabel penjelalas kategorik.

6.2 Tanpa Praproses

set.seed(2024)
no_prep <- recipe(loan_status~.,data = data) %>% 
           #Standardization
           step_normalize(all_numeric_predictors()) %>% 
           #One-hot Encoding
           step_dummy(all_nominal_predictors(),
                      one_hot = TRUE)

no_prep %>% 
  prep() %>% 
  bake(new_data = NULL) %>% 
  glimpse()

## Rows: 4,269
## Columns: 14
## $ no_of_dependents         <dbl> -0.2940673, -1.4733750, 0.2955866, 0.2955866,…
## $ income_annum             <dbl> 1.61778953, -0.34170953, 1.43965325, 1.119007…
## $ loan_amount              <dbl> 1.63286043, -0.32437606, 1.61074476, 1.721323…
## $ loan_term                <dbl> 0.1925940, -0.5080312, 1.5938442, -0.5080312,…
## $ cibil_score              <dbl> 1.0326714, -1.0609269, -0.5447766, -0.7709548…
## $ residential_assets_value <dbl> -0.78340277, -0.73690875, -0.05499633, 1.6652…
## $ commercial_assets_value  <dbl> 2.76999498, -0.63356362, -0.10641313, -0.3814…
## $ luxury_assets_value      <dbl> 0.83193091, -0.69491181, 1.99628579, 0.897837…
## $ bank_asset_value         <dbl> 0.930597525, -0.515930823, 2.407903073, 0.899…
## $ loan_status              <fct>  Approved,  Rejected,  Rejected,  Rejected,  …
## $ education_X.Graduate     <dbl> 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, …
## $ education_X.Not.Graduate <dbl> 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, …
## $ self_employed_X.No       <dbl> 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, …
## $ self_employed_X.Yes      <dbl> 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, …

6.3 Dengan Praproses

set.seed(2024)
basic_prep <- recipe(loan_status~.,data = data) %>% 
           #SMOTE
           step_smotenc(loan_status,over_ratio = 1,neighbors = 7 ) %>% 
           #Standardization
           step_normalize(all_numeric_predictors()) %>% 
           #One-hot Encoding
           step_dummy(all_nominal_predictors(),
                      one_hot = TRUE)

basic_prep %>% 
  prep() %>% 
  bake(new_data = NULL) %>% 
  glimpse()

## Rows: 5,312
## Columns: 14
## $ no_of_dependents         <dbl> -0.3018395, -1.4906216, 0.2925515, 0.2925515,…
## $ income_annum             <dbl> 1.63165760, -0.34251525, 1.45218734, 1.129140…
## $ loan_amount              <dbl> 1.66601665, -0.31918783, 1.64358496, 1.755743…
## $ loan_term                <dbl> 0.1586274, -0.5558404, 1.5875632, -0.5558404,…
## $ cibil_score              <dbl> 1.23390421, -0.86871933, -0.35034399, -0.5774…
## $ residential_assets_value <dbl> -0.79031522, -0.74331726, -0.05401385, 1.6849…
## $ commercial_assets_value  <dbl> 2.81739980, -0.63124312, -0.09710987, -0.3757…
## $ luxury_assets_value      <dbl> 0.83989599, -0.70139749, 2.01527088, 0.906426…
## $ bank_asset_value         <dbl> 0.94884142, -0.51793700, 2.44682789, 0.917633…
## $ loan_status              <fct>  Approved,  Rejected,  Rejected,  Rejected,  …
## $ education_X.Graduate     <dbl> 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, …
## $ education_X.Not.Graduate <dbl> 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, …
## $ self_employed_X.No       <dbl> 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, …
## $ self_employed_X.Yes      <dbl> 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, …

basic_prep %>% 
  prep() %>% 
  bake(new_data = NULL) %>% 
  count(loan_status)

## # A tibble: 2 × 2
##   loan_status     n
##   <fct>       <int>
## 1 " Approved"  2656
## 2 " Rejected"  2656

# Menghitung frekuensi dan persentase masing-masing kategori 'loan_status'
loan_status_count <- basic_prep %>%
  prep() %>%
  bake(new_data = NULL) %>%
  count(loan_status) %>%
  mutate(percent = n * 100 / sum(n),
         label = str_c(round(percent, 2), "%"))

# Membuat plot pie chart
ggplot(loan_status_count, aes(x = "", y = n, fill = loan_status)) +
  geom_col() +
  geom_text(aes(label = label),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y") +
  theme_void() +
  labs(title = "Proporsi Loan Status",
       fill = "Loan Status")

Dari hasil penanganan data tidak seimbang dengan SMOTE diperoleh jumlah tiap masing-masing kategori status sebesar 2656.

7 Split Data

Dilakukan pembagian data training dan data testing dengan pembagian 80:20

basic_split <- initial_split(data = data,
                             prop = 0.8,
                             strata = "loan_status")

tidy(basic_split) %>% 
  count(Data)

## # A tibble: 2 × 2
##   Data           n
##   <chr>      <int>
## 1 Analysis    3414
## 2 Assessment   855

train_df <- training(basic_split)
dim(train_df)

## [1] 3414   12

test_df <- testing(basic_split)
dim(test_df)

## [1] 855  12

Dari pembagian data ini diperoleh data training sebanyak 3414 data dan data testing sebanyak 855 data.

8 Model Random Forest

8.1 Model Training and Evaluation

8.1.1 Mendefenisikan Model

random_forest <- rand_forest() %>%
  set_mode('classification') %>%
  set_engine('ranger', importance = "impurity")

rand_forest() adalah fungsi yang digunakan untuk membuat spesifikasi model Random Forest tanpa parameter tambahan. Ini merupakan bagian dari framework tidymodels.
set_mode('classification') menetapkan model ini untuk tugas klasifikasi.
set_engine('ranger', importance = "impurity") menetapkan ranger sebagai mesin yang digunakan untuk menjalankan algoritma Random Forest. ranger adalah implementasi cepat dari algoritma Random Forest, terutama untuk dataset besar.
Argumen tambahan importance = "impurity" digunakan untuk menghitung pentingnya fitur berdasarkan impurity (ketidakmurnian) dalam pohon keputusan.

8.1.2 Model Training

Model training bisa dilakukan dengan memanfaatkan fungsi workflow seperti dibawah ini:

set.seed(2045)
tic()
random_forest_trained <- workflow() %>% 
              add_recipe(recipe = basic_prep) %>%
              add_model(spec =random_forest) %>%
              fit(train_df)
toc()

## 1.95 sec elapsed

Fungsi add_recipe digunakan untuk menambahkan tahap praproses data menggunakan package recipe.
Fungsi add_model digunakan untuk menambahkan model yang akan dilakukan training.
Fungsi fit digunakan untuk menjalankan training.

8.1.3 Model Evaluation

8.1.3.1 Prediksi Training Data

Berikut adalah sintaks mendapatkan prediksi training data dalam bentuk kategori (factor).

set.seed(2024)
pred_rf_train <- random_forest_trained %>% 
                  predict(new_data = train_df,type = "class")
                  
pred_rf_train

## # A tibble: 3,414 × 1
##    .pred_class
##    <fct>      
##  1 " Approved"
##  2 " Approved"
##  3 " Approved"
##  4 " Approved"
##  5 " Approved"
##  6 " Approved"
##  7 " Approved"
##  8 " Approved"
##  9 " Approved"
## 10 " Approved"
## # ℹ 3,404 more rows

type = "class" argumen untuk mendapatkan prediksi dalam bentuk kategori (factor).

Berikut adalah sintaks mendapatkan prediksi training data dalam bentuk peluang.

prob_rf_train <- random_forest_trained %>% 
  predict(new_data = train_df, type = "prob")
prob_rf_train

## # A tibble: 3,414 × 2
##    `.pred_ Approved` `.pred_ Rejected`
##                <dbl>             <dbl>
##  1             0.970           0.0302 
##  2             0.980           0.0201 
##  3             0.984           0.0162 
##  4             0.999           0.00133
##  5             0.997           0.00290
##  6             0.989           0.0109 
##  7             0.995           0.00478
##  8             0.986           0.0140 
##  9             0.993           0.00704
## 10             0.993           0.00680
## # ℹ 3,404 more rows

8.1.3.2 Confussion Matrix Training Data

Berikut adalah sintaks untuk menambahkan kolom variabel respon dari training data.

pred_rf_train  <- pred_rf_train  %>% 
  mutate(truth = train_df$loan_status)
pred_rf_train

## # A tibble: 3,414 × 2
##    .pred_class truth      
##    <fct>       <fct>      
##  1 " Approved" " Approved"
##  2 " Approved" " Approved"
##  3 " Approved" " Approved"
##  4 " Approved" " Approved"
##  5 " Approved" " Approved"
##  6 " Approved" " Approved"
##  7 " Approved" " Approved"
##  8 " Approved" " Approved"
##  9 " Approved" " Approved"
## 10 " Approved" " Approved"
## # ℹ 3,404 more rows

Selanjutnya, kita akan mengeluarkan confussion matriks.

confussion_matrix_train <- pred_rf_train %>%
                      conf_mat(truth=truth,estimate=.pred_class)

Confusion matriks dapat ditampilkan dalam bentuk chart sebagai berikut:

autoplot(confussion_matrix_train, type = "heatmap") +
  scale_fill_gradient(low = "#F4AFAB", high = "#EE847E")

## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

Fungsi autoplot digunakan untuk mennampilkan confussion matrix.
Fungsi scale_fill_gradient digunakan untuk memberi warna pada confussion matrix.
Berdasarkan output confussion matrix, terdapat 9 kasus status pinjaman sebenarnya rejected tetapi model memprediksi sebagai approved. Selain itu terdapat 1 kasus di mana status pinjaman sebenarnya approved, tetapi model memprediksi sebagai rejected.

8.1.3.3 Evaluasi Model dengan Matric pada Training Data

Pertama-tama, kita harus definsikan terlebih dahulu metrics yang kita gunakan. Metrics-metrics ini didapatkan dengan menggunakan package yardstick.

multi_metric <- metric_set(accuracy, 
                           sensitivity, 
                           specificity, 
                           f_meas)

Fungsi metric_set digunakan untuk menyatukan beberapa metrik evaluasi. F_meas adalah metrik f1-score.

Berikut adalah hasil evaluasi prediksi pada testing data menggunakan 4 metrik yang sudah didefinisikan.

pred_rf_train %>%
  #menambahkan kolom truth
  mutate(truth=train_df$loan_status) %>% 
  # evaluasi prediksi berdasarkan metrik
  multi_metric(truth = truth,estimate = .pred_class)

## # A tibble: 4 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 accuracy    binary         0.997
## 2 sensitivity binary         1.00 
## 3 specificity binary         0.993
## 4 f_meas      binary         0.998

Accuracy (Akurasi): 0.9970709

Akurasi adalah proporsi prediksi yang benar (baik positif maupun negatif) dari keseluruhan jumlah kasus. Dalam kasus ini, model memiliki akurasi sebesar 99.7%, yang berarti model memprediksi dengan benar 99.7% dari semua kasus.
Sensitivity (Sensitivitas) atau Recall: 0.9995292

Sensitivitas adalah proporsi kasus positif yang benar-benar teridentifikasi dengan benar oleh model. Sensitivitas sebesar 99.95% menunjukkan bahwa model berhasil mengidentifikasi semua kasus positif dengan benar (tidak ada False Negatives).
Specificity (Spesifisitas): 0.9930233

Spesifisitas adalah proporsi kasus negatif yang benar-benar teridentifikasi dengan benar oleh model. Spesifisitas sebesar 0.9930233 menunjukkan bahwa model berhasil mengidentifikasi sekitar 99.3% dari semua kasus negatif dengan benar (hanya ada sedikit False Positives).
F-measure (F1-score): 0.9976504

F1-score adalah rata-rata harmonik dari presisi dan sensitivitas. Ini memberikan ukuran seimbang dari kemampuan model dalam mengenali kasus positif, dengan menggabungkan baik False Positives dan False Negatives. Nilai sebesar 99.76% menunjukkan kinerja model yang sangat baik dalam mengidentifikasi kasus positif.

Dengan metrik-metrik ini, dapat disimpulkan bahwa model yang digunakan memiliki kinerja yang sangat baik dalam mengklasifikasikan status pinjaman, dengan akurasi dan keseimbangan yang tinggi antara sensitivitas dan spesifisitas.

8.1.3.4 Prediksi Testing Data

set.seed(2024)
pred_rf_test <- random_forest_trained %>% 
  predict(new_data = test_df, type = "class")
pred_rf_test

## # A tibble: 855 × 1
##    .pred_class
##    <fct>      
##  1 " Approved"
##  2 " Rejected"
##  3 " Rejected"
##  4 " Approved"
##  5 " Rejected"
##  6 " Rejected"
##  7 " Approved"
##  8 " Approved"
##  9 " Approved"
## 10 " Rejected"
## # ℹ 845 more rows

prob_rf_test<- random_forest_trained %>% 
  predict(new_data = test_df, type = "prob")
prob_rf_test

## # A tibble: 855 × 2
##    `.pred_ Approved` `.pred_ Rejected`
##                <dbl>             <dbl>
##  1            0.949             0.0506
##  2            0.0434            0.957 
##  3            0.0297            0.970 
##  4            0.520             0.480 
##  5            0.0206            0.979 
##  6            0.0184            0.982 
##  7            0.924             0.0757
##  8            0.975             0.0247
##  9            0.967             0.0329
## 10            0.0250            0.975 
## # ℹ 845 more rows

8.1.3.5 Confussion Matrix Testing Data

pred_rf_test <- pred_rf_test %>% 
                 #menambahkan kolom truth
                 mutate(truth=test_df$loan_status)
pred_rf_test

## # A tibble: 855 × 2
##    .pred_class truth      
##    <fct>       <fct>      
##  1 " Approved" " Approved"
##  2 " Rejected" " Rejected"
##  3 " Rejected" " Rejected"
##  4 " Approved" " Approved"
##  5 " Rejected" " Rejected"
##  6 " Rejected" " Rejected"
##  7 " Approved" " Approved"
##  8 " Approved" " Approved"
##  9 " Approved" " Approved"
## 10 " Rejected" " Rejected"
## # ℹ 845 more rows

confussion_matrix_test <- pred_rf_test %>%
                      conf_mat(truth=truth,estimate=.pred_class)

autoplot(confussion_matrix_test,type = "heatmap")+
  scale_fill_gradient(low = "#F4AFAB",high = "#EE847E")

## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

Berdasarkan output confussion matrix, terdapat 6 kasus status pinjaman sebenarnya rejected tetapi model memprediksi sebagai approved. Selain itu terdapat 16 kasus di mana status pinjaman sebenarnya approved, tetapi model memprediksi sebagai rejected.

8.1.3.6 Evaluasi model dengan metric

multi_metric <- metric_set(accuracy,
                           sensitivity,
                           specificity,
                           f_meas)

pred_rf_test %>%
  #menambahkan kolom truth
  mutate(truth=test_df$loan_status) %>% 
  # evaluasi prediksi berdasarkan metrik
  multi_metric(truth = truth,estimate = .pred_class)

## # A tibble: 4 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 accuracy    binary         0.974
## 2 sensitivity binary         0.970
## 3 specificity binary         0.981
## 4 f_meas      binary         0.979

Accuracy (Akurasi): 0.9742690

Akurasi adalah proporsi prediksi yang benar (baik positif maupun negatif) dari keseluruhan jumlah kasus. Dalam kasus ini, model memiliki akurasi sebesar 97.42%, yang berarti model memprediksi dengan benar 97.42% dari semua kasus.
Sensitivity (Sensitivitas) atau Recall: 0.9699248

Sensitivitas adalah proporsi kasus positif yang benar-benar teridentifikasi dengan benar oleh model. Sensitivitas sebesar 96.99% menunjukkan bahwa model berhasil mengidentifikasi semua kasus positif dengan benar (tidak ada False Negatives).
Specificity (Spesifisitas): 0.9814241

Spesifisitas adalah proporsi kasus negatif yang benar-benar teridentifikasi dengan benar oleh model. Spesifisitas sebesar 0.9814241 menunjukkan bahwa model berhasil mengidentifikasi sekitar 98.14% dari semua kasus negatif dengan benar (hanya ada sedikit False Positives).
F-measure (F1-score): 0.9791271

F1-score adalah rata-rata harmonik dari presisi dan sensitivitas. Ini memberikan ukuran seimbang dari kemampuan model dalam mengenali kasus positif, dengan menggabungkan baik False Positives dan False Negatives. Nilai sebesar 97.91% menunjukkan kinerja model yang sangat baik dalam mengidentifikasi kasus positif.

Dengan metrik-metrik ini, dapat disimpulkan bahwa model yang digunakan memiliki kinerja yang sangat baik dalam mengklasifikasikan status pinjaman, dengan akurasi dan keseimbangan yang tinggi antara sensitivitas dan spesifisitas.

8.2 Model Selection

8.2.1 Mendefenisikan Model

rf_mod <- rand_forest() %>% 
          set_engine(engine = "ranger",importance="impurity") %>% 
          set_mode(mode = "classification")

8.2.2 Pembagian Data

Pembagian data dilakukan dengan menggunakan metode Cross Validation dengan fungsi vfold_cv

set.seed(2024)
folds <- vfold_cv(data = data,v = 10,strata = "loan_status")

v = 10 untuk menentukan banyaknya fold yang digunakan dalam Cross Validation adalah 10.
strata = "class" metode sampling yang digunakan adalah Stratified Random Sampling dengan stratifikasi berdasarkan kolom class yang berperan sebagai variabel respon.

8.2.3 Model Training and Evaluation

Model Training and Evaluation akan dilakukan dengan bantuan fungsi workflow_set dan workflow_map. Kedua fungsi ini memungkinkan kita untuk melakukan pemilihan model terbaik berdasarkan metrik-metrik tertentu.

Fungsi workflow_set digunakan untuk menginput tahap praproses data dan model apa yang digunakan. Sementara itu, fungsi workflow_map digunakan untuk menginputkan metode pembagian data dan metrik sekaligus melakukan model training and evaluation.

set.seed(2024)
mod_selection_trained <- workflow_set(preproc = list(no=no_prep,basic=basic_prep),
                                      models = list(rf_mod),
                                      cross = TRUE ) %>%
                         workflow_map(fn = "fit_resamples",
                                       resamples= folds,
                                       metrics = multi_metric,
                                       control = control_resamples(save_workflow = TRUE),
                                       seed = 2045)

argumen preproc digunakan untuk menginputkan tahap praproses data
sintaksbasic= digunakan untuk memberi nama pada tahap praproses data
argumen models digunakan untuk menginputkan model
argumen cross=TRUE menandakan bahwa tahap praproses data dan model dipasangkan secara kombinasi. Sebagai ilustrasi tahap praproses data basic akan dipasangkan dengan model decision tree, random forest dan regresi logistik.
argumen cross=TRUE menandakan bahwa tahap praproses data dan model dipasangkan sesuai dengan urutanyan. Sebgai ilustrasi tahap praproses data no dipasangkan dengan decision. tree dan tahap praproses data basic akan dipasangkan dengan random forest. Semetara model regresi logistik tidak punya tahap praproses data sehingga akan menyebabkan error.
argumen fn digunakan untuk menentukan fungsi tidymodels yang akan digunakan.
argumen resamples digunakan untuk menginputkan metode pembagian data
argumen metrics digunakan untuk menginputkan metrik-metrik.

untuk argumen control bisa melihat help untuk lebih jelas.

Hasil training and evaluation pada sintaks sebelumnya disimpan dalam objek mod_selection_trained. Selanjutnya kita akan menampilkan hasilnya dengan menggunakan ranking.

custom_output <- function(data){
  data %>% 
  mutate(method = map_chr(wflow_id, ~ str_split(.x, "_",simplify = TRUE)[1])) %>% 
                        select(method,model,.metric,mean,std_err,rank)
}

mod_selection_result <- rank_results(mod_selection_trained,
                                     rank_metric = "accuracy") %>% 
                        custom_output()
mod_selection_result

## # A tibble: 8 × 6
##   method model       .metric      mean std_err  rank
##   <chr>  <chr>       <chr>       <dbl>   <dbl> <int>
## 1 no     rand_forest accuracy    0.981 0.00172     1
## 2 no     rand_forest f_meas      0.985 0.00138     1
## 3 no     rand_forest sensitivity 0.989 0.00253     1
## 4 no     rand_forest specificity 0.968 0.00378     1
## 5 basic  rand_forest accuracy    0.977 0.00174     2
## 6 basic  rand_forest f_meas      0.982 0.00143     2
## 7 basic  rand_forest sensitivity 0.980 0.00350     2
## 8 basic  rand_forest specificity 0.972 0.00393     2

argumen rank_metric digunakan untuk menentukan metrik apa yang digunakan sebagai ranking.
fungsi custom_output digunakan untuk mengkustomisasi output yang dihasilkan. Fungsi ini bisa tidak perlu dirubah-rubah.

mod_selection_result %>% 
  ggplot(aes(x = rank, y = mean, pch = method, col = model)) + 
  geom_point(cex = 3)+
  facet_wrap(~.metric)+
  theme_bw()

Setelah mendapatkan model terbaik kita bisa mengekstraknya model tersebut kemudian melakukan training ulang dengan seluruh data yang dimiliki menggunakan fungsi fit_best berikut ini.

best_mod <- fit_best(x = mod_selection_trained,
                     metric="accuracy")
best_mod

## ══ Workflow [trained] ══════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: rand_forest()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 2 Recipe Steps
## 
## • step_normalize()
## • step_dummy()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## Ranger result
## 
## Call:
##  ranger::ranger(x = maybe_data_frame(x), y = y, importance = ~"impurity",      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1), probability = TRUE) 
## 
## Type:                             Probability estimation 
## Number of trees:                  500 
## Sample size:                      4269 
## Number of independent variables:  13 
## Mtry:                             3 
## Target node size:                 10 
## Variable importance mode:         impurity 
## Splitrule:                        gini 
## OOB prediction error (Brier s.):  0.01805937

extract_recipe(best_mod)

##

## ── Recipe ──────────────────────────────────────────────────────────────────────

##

## ── Inputs

## Number of variables by role

## outcome:    1
## predictor: 11

##

## ── Training information

## Training data contained 4269 data points and no incomplete rows.

##

## ── Operations

## • Centering and scaling for: no_of_dependents, income_annum, ... | Trained

## • Dummy variables from: education, self_employed | Trained

8.3 Model Interpretability (Explainability)

Untuk mengetahui peubah penjelas mana yang paling berkontribusi terhadap peubah respon, dilakukan perhitungan nilai feature importance dari peubah-peubah penjelas yang digunakan dalam pembentukan model.

# Retraining Random Forest dengan seluruh data
rf_mod_trained <- workflow() %>% 
                    add_recipe(recipe = no_prep) %>% 
                    add_model(spec = rf_mod) %>% 
                    fit(data=data)

plot_importance<- function(rf){
  rf %>% 
  ranger::importance() %>% 
  as.data.frame() %>% 
  rownames_to_column("Variables") %>% 
  rename("impurity"=".") %>% 
  arrange(impurity) %>% 
  mutate(Variables=factor(Variables,levels=Variables)) %>% 
  ggplot(aes(Variables,impurity))+
  geom_col(fill="#03A9F4")+
  coord_flip()+
  theme_classic()+
  theme(axis.line.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.y = element_blank() )+
  scale_y_continuous(expand = c(0,0))
}

extract_fit_engine(rf_mod_trained) %>% 
  plot_importance()

Berdasarkan plot tersebut, terlihat bahwa peubah yang memiliki peranan paling penting untuk menentukan apakah peminjam berpotensi memperoleh pinjaman adalah peubah cibil_score, loan_term, dan loan_amount.

9 Model XGboost

9.1 Model Training and Evaluation

9.1.1 Mendefenisikan Model

xgb_spec <- boost_tree() %>% 
  set_engine("xgboost") %>% 
  set_mode("classification")

boost_tree()’ adalah fungsi dari paket parsnip yang digunakan untuk membuat spesifikasi model untuk model pohon yang akan ditingkatkan, seperti XGBoost.
set_engine("xgboost"): Ini adalah fungsi dari paket parsnip yang digunakan untuk menentukan mesin pembelajaran yang akan digunakan untuk menjalankan model, dalam hal ini, xgboost (XGBoost).
set_mode('classification') menetapkan model ini untuk tugas klasifikasi.

9.1.2 Model Training

Model training bisa dilakukan dengan memanfaatkan fungsi workflow seperti dibawah ini:

set.seed(2045)
tic()
xgboost_trained <- workflow() %>% 
              add_recipe(recipe = basic_prep) %>%
              add_model(spec =xgb_spec) %>%
              fit(train_df)
toc()

## 1.06 sec elapsed

Fungsi add_recipe digunakan untuk menambahkan tahap praproses data menggunakan package recipe.
Fungsi add_model digunakan untuk menambahkan model yang akan dilakukan training.
Fungsi fit digunakan untuk menjalankan training.

9.1.3 Model Evaluation

9.1.3.1 Prediksi Training Data

Berikut adalah sintaks mendapatkan prediksi training data dalam bentuk kategori (factor).

set.seed(2024)
pred_xgb_train <- xgboost_trained %>% 
  predict(new_data = train_df, type = "class")
pred_xgb_train

## # A tibble: 3,414 × 1
##    .pred_class
##    <fct>      
##  1 " Approved"
##  2 " Approved"
##  3 " Approved"
##  4 " Approved"
##  5 " Approved"
##  6 " Approved"
##  7 " Approved"
##  8 " Approved"
##  9 " Approved"
## 10 " Approved"
## # ℹ 3,404 more rows

type = "class" argumen untuk mendapatkan prediksi dalam bentuk kategori (factor).

Berikut adalah sintaks mendapatkan prediksi training data dalam bentuk peluang.

prob_xgb_train <- xgboost_trained %>% 
  predict(new_data = train_df, type = "prob")
prob_xgb_train

## # A tibble: 3,414 × 2
##    `.pred_ Approved` `.pred_ Rejected`
##                <dbl>             <dbl>
##  1             0.994           0.00563
##  2             0.987           0.0131 
##  3             0.994           0.00563
##  4             0.994           0.00563
##  5             0.994           0.00563
##  6             0.994           0.00563
##  7             0.994           0.00563
##  8             0.994           0.00563
##  9             0.994           0.00563
## 10             0.994           0.00563
## # ℹ 3,404 more rows

9.1.3.2 Confussion Matrix Training Data

Berikut adalah sintaks untuk menambahkan kolom variabel respon dari training data.

pred_xgb_train  <- pred_xgb_train  %>% 
  mutate(truth = train_df$loan_status)
pred_rf_train

## # A tibble: 3,414 × 2
##    .pred_class truth      
##    <fct>       <fct>      
##  1 " Approved" " Approved"
##  2 " Approved" " Approved"
##  3 " Approved" " Approved"
##  4 " Approved" " Approved"
##  5 " Approved" " Approved"
##  6 " Approved" " Approved"
##  7 " Approved" " Approved"
##  8 " Approved" " Approved"
##  9 " Approved" " Approved"
## 10 " Approved" " Approved"
## # ℹ 3,404 more rows

Selanjutnya, kita akan mengeluarkan confussion matriks.

confussion_matrix_train <- pred_rf_train %>%
                      conf_mat(truth=truth,estimate=.pred_class)

Confusion matriks dapat ditampilkan dalam bentuk chart sebagai berikut:

autoplot(confussion_matrix_train, type = "heatmap") +
  scale_fill_gradient(low = "#F4AFAB", high = "#EE847E")

## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

Fungsi autoplot digunakan untuk mennampilkan confussion matrix.
Fungsi scale_fill_gradient digunakan untuk memberi warna pada confussion matrix.
Berdasarkan output confussion matrix, terdapat 9 kasus status pinjaman sebenarnya rejected tetapi model memprediksi sebagai approved. Selain itu terdapat 1 kasus di mana status pinjaman sebenarnya approved, tetapi model memprediksi sebagai rejected.

9.1.3.3 Evaluasi Model dengan Matric pada Training Data

Pertama-tama, kita harus definsikan terlebih dahulu metrics yang kita gunakan. Metrics-metrics ini didapatkan dengan menggunakan package yardstick.

multi_metric <- metric_set(accuracy,
                           sensitivity,
                           specificity,
                           f_meas)

Fungsi metric_set digunakan untuk menyatukan beberapa metrik evaluasi. F_meas adalah metrik f1-score.

Berikut adalah hasil evaluasi prediksi pada testing data menggunakan 5 metrik yang sudah didefinisikan.

pred_xgb_train %>%
  #menambahkan kolom truth
  mutate(truth=train_df$loan_status) %>% 
  # evaluasi prediksi berdasarkan metrik
  multi_metric(truth = truth,estimate = .pred_class)

## # A tibble: 4 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 accuracy    binary         0.997
## 2 sensitivity binary         0.999
## 3 specificity binary         0.995
## 4 f_meas      binary         0.998

Accuracy (Akurasi): 0.9973638

Akurasi adalah proporsi prediksi yang benar (baik positif maupun negatif) dari keseluruhan jumlah kasus. Dalam kasus ini, model memiliki akurasi sebesar 99.73%, yang berarti model memprediksi dengan benar 99.73% dari semua kasus.
Sensitivity (Sensitivitas) atau Recall: 0.9985876

Sensitivitas adalah proporsi kasus positif yang benar-benar teridentifikasi dengan benar oleh model. Sensitivitas sebesar 99.85% menunjukkan bahwa model berhasil mengidentifikasi semua kasus positif dengan benar (tidak ada False Negatives).
Specificity (Spesifisitas): 0.9953488

Spesifisitas adalah proporsi kasus negatif yang benar-benar teridentifikasi dengan benar oleh model. Spesifisitas sebesar 0.9953488 menunjukkan bahwa model berhasil mengidentifikasi sekitar 99.53% dari semua kasus negatif dengan benar (hanya ada sedikit False Positives).
F-measure (F1-score): 0.9978829

F1-score adalah rata-rata harmonik dari presisi dan sensitivitas. Ini memberikan ukuran seimbang dari kemampuan model dalam mengenali kasus positif, dengan menggabungkan baik False Positives dan False Negatives. Nilai sebesar 99.78% menunjukkan kinerja model yang sangat baik dalam mengidentifikasi kasus positif.

Dengan metrik-metrik ini, dapat disimpulkan bahwa model yang digunakan memiliki kinerja yang sangat baik dalam mengklasifikasikan status pinjaman, dengan akurasi dan keseimbangan yang tinggi antara sensitivitas dan spesifisitas.

9.1.3.4 Prediksi Testing Data

set.seed(2024)
pred_xgb_test <- xgboost_trained %>%    
  predict(new_data = test_df, type = "class") 
pred_xgb_test

## # A tibble: 855 × 1
##    .pred_class
##    <fct>      
##  1 " Approved"
##  2 " Rejected"
##  3 " Rejected"
##  4 " Approved"
##  5 " Rejected"
##  6 " Rejected"
##  7 " Approved"
##  8 " Approved"
##  9 " Approved"
## 10 " Rejected"
## # ℹ 845 more rows

prob_xgb_test <- xgboost_trained %>%    
  predict(new_data = test_df, type = "prob") 
prob_xgb_test

## # A tibble: 855 × 2
##    `.pred_ Approved` `.pred_ Rejected`
##                <dbl>             <dbl>
##  1           0.994             0.00563
##  2           0.00539           0.995  
##  3           0.00539           0.995  
##  4           0.704             0.296  
##  5           0.00539           0.995  
##  6           0.00539           0.995  
##  7           0.982             0.0179 
##  8           0.934             0.0662 
##  9           0.988             0.0117 
## 10           0.00539           0.995  
## # ℹ 845 more rows

9.1.3.5 Confussion Matrix Testing Data

pred_xgb_test  <- pred_xgb_test  %>%    
  mutate(truth = test_df$loan_status) 
pred_rf_test

## # A tibble: 855 × 2
##    .pred_class truth      
##    <fct>       <fct>      
##  1 " Approved" " Approved"
##  2 " Rejected" " Rejected"
##  3 " Rejected" " Rejected"
##  4 " Approved" " Approved"
##  5 " Rejected" " Rejected"
##  6 " Rejected" " Rejected"
##  7 " Approved" " Approved"
##  8 " Approved" " Approved"
##  9 " Approved" " Approved"
## 10 " Rejected" " Rejected"
## # ℹ 845 more rows

confussion_matrix_testxgb <- pred_xgb_test %>%                       
  conf_mat(truth=truth,estimate=.pred_class)

autoplot(confussion_matrix_testxgb, type = "heatmap") +   
  scale_fill_gradient(low = "#F4AFAB", high = "#EE847E")

## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

Berdasarkan output confussion matrix, terdapat 7 kasus status pinjaman sebenarnya rejected tetapi model memprediksi sebagai approved. Selain itu terdapat 7 kasus di mana status pinjaman sebenarnya approved, tetapi model memprediksi sebagai rejected.

9.1.3.6 Evaluasi Model dengan Matric pada Testing Data

multi_metric <- metric_set(accuracy,
                           sensitivity,
                           specificity,
                           f_meas)

pred_xgb_test %>%   #menambahkan kolom truth   
  mutate(truth=test_df$loan_status) %>%    # evaluasi prediksi berdasarkan metrik
  multi_metric(truth = truth,estimate = .pred_class)

## # A tibble: 4 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 accuracy    binary         0.984
## 2 sensitivity binary         0.987
## 3 specificity binary         0.978
## 4 f_meas      binary         0.987

Accuracy (Akurasi): 0.9836257

Akurasi adalah proporsi prediksi yang benar (baik positif maupun negatif) dari keseluruhan jumlah kasus. Dalam kasus ini, model memiliki akurasi sebesar 98.36%, yang berarti model memprediksi dengan benar 98.36% dari semua kasus.
Sensitivity (Sensitivitas) atau Recall: 0.9868421

Sensitivitas adalah proporsi kasus positif yang benar-benar teridentifikasi dengan benar oleh model. Sensitivitas sebesar 98.68% menunjukkan bahwa model berhasil mengidentifikasi semua kasus positif dengan benar (tidak ada False Negatives).
Specificity (Spesifisitas): 0.9783282

Spesifisitas adalah proporsi kasus negatif yang benar-benar teridentifikasi dengan benar oleh model. Spesifisitas sebesar 0.9783282 menunjukkan bahwa model berhasil mengidentifikasi sekitar 97.83% dari semua kasus negatif dengan benar (hanya ada sedikit False Positives).
F-measure (F1-score): 0.986842

F1-score adalah rata-rata harmonik dari presisi dan sensitivitas. Ini memberikan ukuran seimbang dari kemampuan model dalam mengenali kasus positif, dengan menggabungkan baik False Positives dan False Negatives. Nilai sebesar 98.68% menunjukkan kinerja model yang sangat baik dalam mengidentifikasi kasus positif.

Dengan metrik-metrik ini, dapat disimpulkan bahwa model yang digunakan memiliki kinerja yang sangat baik dalam mengklasifikasikan status pinjaman, dengan akurasi dan keseimbangan yang tinggi antara sensitivitas dan spesifisitas.

9.2 Model Selection

9.2.1 Mendefenisikan model

rf_mod <- rand_forest() %>% 
          set_engine(engine = "ranger",importance="impurity") %>% 
          set_mode(mode = "classification")

xgb_spec <- boost_tree() %>% 
  set_engine("xgboost") %>% 
  set_mode("classification")

9.2.2 Pembagian Data

Pembagian data dilakukan dengan menggunakan metode Cross Validation dengan fungsi vfold_cv

set.seed(2024)
folds <- vfold_cv(data = data,v = 10,strata = "loan_status")

v = 10 untuk menentukan banyaknya fold yang digunakan dalam Cross Validation adalah 10.
strata = "class" metode sampling yang digunakan adalah Stratified Random Sampling dengan stratifikasi berdasarkan kolom class yang berperan sebagai variabel respon.

9.2.3 Model Training and Evaluation

set.seed(2024)
mod_selection_trained <- workflow_set(preproc = list(no=no_prep, basic=basic_prep),
                                      models = list(rf_mod,xgb_spec),
                                      cross = TRUE ) %>%
                         workflow_map(fn = "fit_resamples",
                                       resamples= folds,
                                       metrics = multi_metric,
                                       control = control_resamples(save_workflow = TRUE),
                                       seed = 2045)

argumen preproc digunakan untuk menginputkan tahap praproses data
sintaksbasic= digunakan untuk memberi nama pada tahap praproses data
argumen models digunakan untuk menginputkan model random forest dan xgboost
argumen cross=TRUE menandakan bahwa tahap praproses data dan model dipasangkan secara kombinasi. Sebagai ilustrasi tahap praproses data basic akan dipasangkan dengan model decision tree, random forest dan regresi logistik.
argumen cross=TRUE menandakan bahwa tahap praproses data dan model dipasangkan sesuai dengan urutanyan. Sebgai ilustrasi tahap praproses data no dipasangkan dengan decision. tree dan tahap praproses data basic akan dipasangkan dengan random forest. Semetara model regresi logistik tidak punya tahap praproses data sehingga akan menyebabkan error.
argumen fn digunakan untuk menentukan fungsi tidymodels yang akan digunakan.
argumen resamples digunakan untuk menginputkan metode pembagian data
argumen metrics digunakan untuk menginputkan metrik-metrik.

untuk argumen control bisa melihat help untuk lebih jelas.

Hasil training and evaluation pada sintaks sebelumnya disimpan dalam objek mod_selection_trained. Selanjutnya kita akan menampilkan hasilnya dengan menggunakan ranking.

custom_output <- function(data){
  data %>% 
  mutate(method = map_chr(wflow_id, ~ str_split(.x, "_",simplify = TRUE)[1])) %>% 
                        select(method,model,.metric,mean,std_err,rank)
}

mod_selection_result <- rank_results(mod_selection_trained,
                                     rank_metric = "accuracy") %>% 
                        custom_output()
mod_selection_result

## # A tibble: 16 × 6
##    method model       .metric      mean  std_err  rank
##    <chr>  <chr>       <chr>       <dbl>    <dbl> <int>
##  1 basic  boost_tree  accuracy    0.985 0.00120      1
##  2 basic  boost_tree  f_meas      0.988 0.000976     1
##  3 basic  boost_tree  sensitivity 0.988 0.00266      1
##  4 basic  boost_tree  specificity 0.980 0.00377      1
##  5 no     boost_tree  accuracy    0.985 0.00212      2
##  6 no     boost_tree  f_meas      0.988 0.00167      2
##  7 no     boost_tree  sensitivity 0.992 0.00224      2
##  8 no     boost_tree  specificity 0.972 0.00659      2
##  9 no     rand_forest accuracy    0.981 0.00172      3
## 10 no     rand_forest f_meas      0.985 0.00138      3
## 11 no     rand_forest sensitivity 0.989 0.00253      3
## 12 no     rand_forest specificity 0.968 0.00378      3
## 13 basic  rand_forest accuracy    0.977 0.00174      4
## 14 basic  rand_forest f_meas      0.982 0.00143      4
## 15 basic  rand_forest sensitivity 0.980 0.00350      4
## 16 basic  rand_forest specificity 0.972 0.00393      4

argumen rank_metric digunakan untuk menentukan metrik apa yang digunakan sebagai ranking.
fungsi custom_output digunakan untuk mengkustomisasi output yang dihasilkan. Fungsi ini bisa tidak perlu dirubah-rubah.

mod_selection_result %>% 
  ggplot(aes(x = rank, y = mean, pch = method, col = model)) + 
  geom_point(cex = 3)+
  facet_wrap(~.metric)+
  theme_bw()

Dari visualisasi hasil perbandingan kedua metode diperoleh secara keseluruhan metode XGboost lebih unggul dari Random Forest baik dari segi accuracy, f_means, sensitivity, dan specificity.

Setelah mendapatkan model terbaik kita bisa mengekstraknya model tersebut kemudian melakukan training ulang dengan seluruh data yang dimiliki menggunakan fungsi fit_best berikut ini.

best_mod <- fit_best(x = mod_selection_trained,
                     metric="accuracy")
best_mod

## ══ Workflow [trained] ══════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: boost_tree()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 3 Recipe Steps
## 
## • step_smotenc()
## • step_normalize()
## • step_dummy()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## ##### xgb.Booster
## raw: 33 Kb 
## call:
##   xgboost::xgb.train(params = list(eta = 0.3, max_depth = 6, gamma = 0, 
##     colsample_bytree = 1, colsample_bynode = 1, min_child_weight = 1, 
##     subsample = 1), data = x$data, nrounds = 15, watchlist = x$watchlist, 
##     verbose = 0, nthread = 1, objective = "binary:logistic")
## params (as set within xgb.train):
##   eta = "0.3", max_depth = "6", gamma = "0", colsample_bytree = "1", colsample_bynode = "1", min_child_weight = "1", subsample = "1", nthread = "1", objective = "binary:logistic", validate_parameters = "TRUE"
## xgb.attributes:
##   niter
## callbacks:
##   cb.evaluation.log()
## # of features: 13 
## niter: 15
## nfeatures : 13 
## evaluation_log:
##     iter training_logloss
##        1       0.45327838
##        2       0.31964884
## ---                      
##       14       0.02840864
##       15       0.02581924

extract_recipe(best_mod)

##

## ── Recipe ──────────────────────────────────────────────────────────────────────

##

## ── Inputs

## Number of variables by role

## outcome:    1
## predictor: 11

##

## ── Training information

## Training data contained 4269 data points and no incomplete rows.

##

## ── Operations

## • SMOTENC based on: loan_status | Trained

## • Centering and scaling for: no_of_dependents, income_annum, ... | Trained

## • Dummy variables from: education, self_employed | Trained

9.3 Model Interpretability (Explainability)

best_mod_explainer <- extract_fit_engine(best_mod)

plot_xgb_importance<- function(model,filter=10){
    xgboost::xgb.importance(model = model) %>% 
    arrange(Gain) %>% 
    mutate(Feature=factor(Feature,levels=Feature)) %>% 
    slice_max(order_by = Gain,n = filter) %>% 
  ggplot(aes(Feature,Gain))+
  geom_col(fill="orange")+
  coord_flip()+
  theme_classic()+
  theme(axis.line.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.y = element_blank() )+
  scale_y_continuous(expand = c(0,0))
}

library(ranger)
best_mod_explainer %>% 
  plot_xgb_importance(filter=11)

9.3.1 Insight

Berdasarkan analisis feature importance, Cibil Score, Loan Term, dan Loan Amount adalah variabel paling penting dalam menentukan kemungkinan peminjam memperoleh pinjaman. - Semakin tinggi Cibil Score, semakin besar peluang peminjam mendapatkan pinjaman karena menunjukkan riwayat kredit yang baik. - Loan Term yang lebih pendek cenderung lebih disukai karena mengurangi risiko ketidakpastian pembayaran dalam jangka panjang. - Loan Amount yang diminta juga mempengaruhi keputusan, dengan jumlah yang lebih besar meningkatkan risiko bagi pemberi pinjaman. Oleh karena itu, lembaga keuangan dapat fokus pada peminjam dengan Cibil Score tinggi, menawarkan jangka waktu pinjaman yang lebih pendek, dan menerapkan penilaian kredit yang lebih ketat untuk jumlah pinjaman yang besar guna mengurangi risiko kredit macet.

10 Perbandingan Model

Model	Accuracy	Sensitivity	Spesificity	F1-Score
Random Forest (Tanpa Penanganan)	0.9810	0.9890	0.9677	0.9848
Random Forest (Dengan penanganan)	0.9772	0.9804	0.9721	0.9817
XGBoost (Tanpa penanganan)	0.9847	0.9924	0.9721	0.9878
XGBoost (Dengan penanganan)	0.9852	0.9883	0.9801	0.9881

11 Kesimpulan

Model terbaik untuk memprediksi peminjam yang berpotensi untuk menerima pinjaman adalah model XGBoost dengan perlakuan menggunakan penanganan imbalanced data ukuran kebaikan model yang lebih tinggi dibanding Random Forest dari segi accuracy, sensitivity, spesificity, f1-score.
Peubah yang berperan penting untuk memprediksi peminjam yang berpotensi untuk menerima pinjaman adalah peubah Cibil Score, Loan Term, dan Loan Amount.

Klasifikasi Persetujuan Pinjaman Menggunakan Pembelajaran Ensemble pada Data Tidak Seimbang

Rahmi Anadra

Desember 13, 2024

1 Mengaktifkan Package

2 Import Data

3 Cek Missing Value

4 Cek Data Duplikat

5 Eksplorasi Data

5.1 Eksploarasi Peubah Respon

5.2 Eksplorasi Secara Numerik

5.3 Eksplorasi Hubungan Penjelas Kategorik dengan Respon

5.4 Eksplorasi Hubungan Penjelas Kontinu dengan Respon

5.5 Eksploarsi Hubungan antar Penjelas Kontinu

6 Praproses Data

6.1 Penanganan Outlier dengan IQR

6.2 Tanpa Praproses

6.3 Dengan Praproses

7 Split Data

8 Model Random Forest

8.1 Model Training and Evaluation

8.1.1 Mendefenisikan Model

8.1.2 Model Training

8.1.3 Model Evaluation

8.1.3.1 Prediksi Training Data

8.1.3.2 Confussion Matrix Training Data

8.1.3.3 Evaluasi Model dengan Matric pada Training Data

8.1.3.4 Prediksi Testing Data

8.1.3.5 Confussion Matrix Testing Data

8.1.3.6 Evaluasi model dengan metric

8.2 Model Selection

8.2.1 Mendefenisikan Model

8.2.2 Pembagian Data

8.2.3 Model Training and Evaluation

8.3 Model Interpretability (Explainability)

9 Model XGboost

9.1 Model Training and Evaluation

9.1.1 Mendefenisikan Model

9.1.2 Model Training

9.1.3 Model Evaluation

9.1.3.1 Prediksi Training Data

9.1.3.2 Confussion Matrix Training Data

9.1.3.3 Evaluasi Model dengan Matric pada Training Data

9.1.3.4 Prediksi Testing Data

9.1.3.5 Confussion Matrix Testing Data

9.1.3.6 Evaluasi Model dengan Matric pada Testing Data

9.2 Model Selection

9.2.1 Mendefenisikan model

9.2.2 Pembagian Data

9.2.3 Model Training and Evaluation

9.3 Model Interpretability (Explainability)

9.3.1 Insight

10 Perbandingan Model

11 Kesimpulan