Package
Silahkan install jika belum ada
install.packages("tidyverse")
install.packages("paradox")
install.packages("mlr3")
install.packages("mlr3learners")
install.packages("scorecard")library(tidyverse)## -- Attaching packages ------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts --------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(mlr3)
library(paradox)
library(mlr3learners)
library(mlr3pipelines)Deskripsi singkat data
Tutorial kali ini akan menggunakan data yaitu German Credit. Berikut adalah informasi singkat mengenai data
This dataset classifies people described by a set of attributes as good or bad credit risks.
Author: Dr. Hans Hofmann Source: UCI - 1994 Please cite: Dua, D. and Graff, C. (2019). UCI Machine Learning Repository [http://archive.ics.uci.edu/ml]. Irvine, CA: University of California, School of Information and Computer Science.
Attribute description
- Status of existing checking account, in Deutsche Mark.
- Credit history (credits taken, paid back duly, delays, critical accounts)
- Purpose of the credit (car, television,…)
- Credit amount
- Status of savings account/bonds, in Deutsche Mark.
- Present employment, in number of years.
- Installment rate in percentage of disposable income
- Personal status (married, single,…) and sex
- Other debtors / guarantors
- Present residence since X years
- Property (e.g. real estate)
- Age in years
- Other installment plans (banks, stores)
- Housing (rent, own,…)
- Number of existing credits at this bank
- Job
- Number of people being liable to provide maintenance for
- Telephone (yes,no)
- Foreign worker (yes,no)
- Duration in months
data ini bisa diperoleh di link berikut ini https://www.openml.org/data/get_csv/31/dataset_31_credit-g.arff
Pada bagian ini akan dibahas bagaimana melakukan diskretisasi pada ekosistem mlr3 yang kemudian diterapkan pada model regresi logistik. Adapun langkah-langkah pemodelannya mirip pada tutorial sebelumnya, yaitu:
- Import data di R
- Import data ke ekosistem mlr3
- Menentukan diskritiasasi dan model yang digunakan
- Menentukan cara pembagian data
- Melakukan training dan menghitung performa model
Pada tutorial ini, diskritisasi akan dilustrasikan menggunakan 4 metode diskritisasi (equal width, equal frequency,MDLP dan Chi-Merge).
Import data di R
data_credit <- read.csv("german_credit.csv",stringsAsFactors = TRUE)
dplyr::glimpse(data_credit)## Rows: 1,000
## Columns: 21
## $ checking_status <fct> '<0', '0<=X<200', 'no checking', '<0', '<0',...
## $ duration <int> 6, 48, 12, 42, 24, 36, 24, 36, 12, 30, 12, 4...
## $ credit_history <fct> 'critical/other existing credit', 'existing ...
## $ purpose <fct> radio/tv, radio/tv, education, furniture/equ...
## $ credit_amount <int> 1169, 5951, 2096, 7882, 4870, 9055, 2835, 69...
## $ savings_status <fct> 'no known savings', '<100', '<100', '<100', ...
## $ employment <fct> '>=7', '1<=X<4', '4<=X<7', '4<=X<7', '1<=X<4...
## $ installment_commitment <int> 4, 2, 2, 2, 3, 2, 3, 2, 2, 4, 3, 3, 1, 4, 2,...
## $ personal_status <fct> 'male single', 'female div/dep/mar', 'male s...
## $ other_parties <fct> none, none, none, guarantor, none, none, non...
## $ residence_since <int> 4, 2, 3, 4, 4, 4, 4, 2, 4, 2, 1, 4, 1, 4, 4,...
## $ property_magnitude <fct> 'real estate', 'real estate', 'real estate',...
## $ age <int> 67, 22, 49, 45, 53, 35, 53, 35, 61, 28, 25, ...
## $ other_payment_plans <fct> none, none, none, none, none, none, none, no...
## $ housing <fct> own, own, own, 'for free', 'for free', 'for ...
## $ existing_credits <int> 2, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1,...
## $ job <fct> skilled, skilled, 'unskilled resident', skil...
## $ num_dependents <int> 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
## $ own_telephone <fct> yes, none, none, none, none, yes, none, yes,...
## $ foreign_worker <fct> yes, yes, yes, yes, yes, yes, yes, yes, yes,...
## $ class <fct> good, bad, good, good, bad, good, good, good...Khusus yang menggunakan R versi 4.00 keatas, argumen stringsAsFactors = TRUE disertakan agar data yang berbentuk string bisa berubah menjadi factor.
Diskretisasi
Import data ke ekosistem mlr3
Pada tahap ini fungsi TaskClassif digunakan untuk import data dari R ke mlr3. Karena target/peubah respon dari data ini adalah peubah biner maka termasuk dalam masalah klasifikasi.
task_credit = TaskClassif$new(id="credit",backend = data_credit,target = "class",positive ="bad")Menentukan diskritiasasi dan model yang digunakan
Disktritisasi merupakan salah satu metode preprocessing data, oleh karena itu fungsi po dari package mlr3pipelines bisa digunakan untuk memanggil process tersebut. Sebelum menjalankan fungsi po, terlebih dahulu akan dipanggil user-defined function (fungsi buatan sendiri) PipeOpBinning dengan fungsi source yang argumen utamanya adalah alamat file. Jika file PipeOpBinning.R berada dalam working directory maka sintaksnya bisa ditulis seperti dibawah ini. Jika berada di tempat yang berbeda maka tuliskan lengkap alamatnya misal source("D:\Tesis\PipeOpBinning.R").
source("PipeOpBinning.R") Agar sintaks diatas dapat dijalankan terlebih dahulu harus mendowload file PipeOpBinning.R dari
https://github.com/gerrydito/Model-Klasifikasi/raw/master/Praktikum/diskritisasi/PipeOpBinning.R.
Setelah itu kita dapat menerapkan fungsi po seperti diabawah ini
## equal width
eq_width_binning <- po("binning",method="width",id="width")%>>%
po("learner",lrn("classif.log_reg"))
## equal frequency
eq_freq_binning <- po("binning",method="freq",id="freq")%>>%
po("learner",lrn("classif.log_reg"))
## MDLP
mdlp_binning <- po("binning",method="tree",id="mdlp")%>>%
po("learner",lrn("classif.log_reg"))
## Chi Merge
chimerge_binning <- po("binning",method="chimerge",id="chimerge")%>>%
po("learner",lrn("classif.log_reg"))Perlu diperhatikan bahwa model yang kita gunakan setelah dilakukan diskritisasi adalah regresi logistik. Selain itu pada setiap po("binning") ditambahkan juga argumen id untuk membantu kita mengidentifikasi proses binning mana yang digunakan pada saat melihat hasil performa model.
Kemudian, semua proses diatas bisa disimpan dalam bentuk list seperti dibawah ini dengan tambahan satu model regresi logistik tanpa dilakukan proses diskritisasi.
learner_credit <- list(eq_width_binning,eq_freq_binning,mdlp_binning,
chimerge_binning, lrn("classif.log_reg")
)Menentukan cara pembagian data
Metode pembagian data ditentukan dengan menggunakan fungsi rsmp.
resample_credit_cv = rsmp("holdout",ratio = 0.8)Metode pembagian data yang dipilih disini adalah metode holdout dengan pembagian 80% untuk data training dan 20% untuk data testing. Tentu saja dianjurkan untuk menggunakan cross-validation untuk memperoleh hasil yang lebih akurat.
Melakukan training dan menghitung performa model
Proses training dapat dilakukan dengan menggunakan fungsi benchmark_grid dan benchmark karena melibatkan lebih dari satu data preprocessing.
design <- benchmark_grid(tasks = task_credit,
learners = learner_credit,
resamplings = resample_credit_cv
)Fungsi benchmark digunakan untuk menjalankan/ running berdasarkan desain yang sudah dirancang.
bmr = benchmark(design,store_models = TRUE)## INFO [09:41:31.730] Benchmark with 5 resampling iterations
## INFO [09:41:37.259] Applying learner 'width.classif.log_reg' on task 'credit' (iter 1/1)
## [INFO] creating woe binning ...
## [INFO] converting into woe values ...
## [INFO] converting into woe values ...
## INFO [09:42:07.217] Applying learner 'freq.classif.log_reg' on task 'credit' (iter 1/1)
## [INFO] creating woe binning ...
## [INFO] converting into woe values ...
## [INFO] converting into woe values ...
## INFO [09:42:36.279] Applying learner 'mdlp.classif.log_reg' on task 'credit' (iter 1/1)
## [INFO] creating woe binning ...
## [INFO] Binning on 800 rows and 8 columns in 00:00:16
## [INFO] converting into woe values ...
## [INFO] converting into woe values ...
## INFO [09:43:09.645] Applying learner 'chimerge.classif.log_reg' on task 'credit' (iter 1/1)
## [INFO] creating woe binning ...
## [INFO] Binning on 800 rows and 8 columns in 00:00:12
## [INFO] converting into woe values ...
## [INFO] converting into woe values ...
## INFO [09:43:37.433] Applying learner 'classif.log_reg' on task 'credit' (iter 1/1)
## INFO [09:43:37.625] Finished benchmarkHasil Komparasi model
Hasil komparasi model dapat berupa nilai-nilai ukuran kebaikan model yang ditentukan oleh pengguna.
result = bmr$aggregate(list(msr("classif.acc"),
msr("classif.specificity"),
msr("classif.sensitivity")
))
result## resample_result nr task_id learner_id resampling_id iters
## 1: <ResampleResult> 1 credit width.classif.log_reg holdout 1
## 2: <ResampleResult> 2 credit freq.classif.log_reg holdout 1
## 3: <ResampleResult> 3 credit mdlp.classif.log_reg holdout 1
## 4: <ResampleResult> 4 credit chimerge.classif.log_reg holdout 1
## 5: <ResampleResult> 5 credit classif.log_reg holdout 1
## classif.acc classif.specificity classif.sensitivity
## 1: 0.805 0.9136691 0.5573770
## 2: 0.795 0.9064748 0.5409836
## 3: 0.785 0.8776978 0.5737705
## 4: 0.810 0.9208633 0.5573770
## 5: 0.790 0.8920863 0.5573770Berdasarkan nilai akurasi dan sensitivity model regresi logistik lebih unggul dibandingkan model KNN. Namun, untuk specificity model KNN lebih unggul dibandingkan dengan model regresi logistik.
Untuk melakukan verifikasi proses binning benar2 dilakukan atau tidak bisa menggunakan sintaks dibawah ini
i=1
as.data.table(bmr)$learner[[i]]$model$classif.log_reg$model##
## Call: stats::glm(formula = task$formula(), family = "binomial", data = task$data(),
## model = FALSE)
##
## Coefficients:
## (Intercept)
## 0.491660
## checking_status'>=200'
## 0.755832
## checking_status'0<=X<200'
## 0.351756
## checking_status'no checking'
## 1.586683
## credit_history'critical/other existing credit'
## 1.461707
## credit_history'delayed previously'
## 0.912157
## credit_history'existing paid'
## 0.634441
## credit_history'no credits/all paid'
## -0.313288
## employment'>=7'
## -0.002352
## employment'1<=X<4'
## 0.178562
## employment'4<=X<7'
## 0.651256
## employmentunemployed
## 0.341298
## foreign_workeryes
## -1.164365
## housingown
## -0.378669
## housingrent
## -0.682753
## job'unemp/unskilled non res'
## 0.168072
## job'unskilled resident'
## 0.144252
## jobskilled
## 0.085895
## other_partiesguarantor
## 1.726094
## other_partiesnone
## 0.508840
## other_payment_plansnone
## 0.354469
## other_payment_plansstores
## -0.215254
## own_telephoneyes
## 0.222622
## personal_status'male div/sep'
## -0.040998
## personal_status'male mar/wid'
## 0.391418
## personal_status'male single'
## 0.651295
## property_magnitude'no known property'
## -0.672645
## property_magnitude'real estate'
## 0.456935
## property_magnitudecar
## 0.153406
## purpose'new car'
## -0.469127
## purpose'used car'
## 0.834440
## purposebusiness
## 0.114920
## purposeeducation
## -0.355102
## purposefurniture/equipment
## 0.206997
## purposeother
## 0.683914
## purposeradio/tv
## 0.544213
## purposerepairs
## -0.360477
## purposeretraining
## 1.267144
## savings_status'>=1000'
## 1.230272
## savings_status'100<=X<500'
## 0.278392
## savings_status'500<=X<1000'
## 0.425923
## savings_status'no known savings'
## 1.165184
## age_bin[26,33)
## 0.476389
## age_bin[33,40)
## 0.586917
## age_bin[40,47)
## 0.490458
## age_bin[47,54)
## 0.747018
## age_bin[54, Inf)
## 0.787812
## credit_amount_bin[2521.75,4793.5)
## 0.387015
## credit_amount_bin[4793.5,7065.25)
## -0.081946
## credit_amount_bin[7065.25, Inf)
## -0.610924
## duration_bin[11,18)
## -0.324473
## duration_bin[18,25)
## -0.779418
## duration_bin[25,32)
## -0.185040
## duration_bin[32,39)
## -1.033279
## duration_bin[39, Inf)
## -1.472001
## existing_credits_bin[2, Inf)
## -0.288007
## installment_commitment_bin[2,3)
## -0.399465
## installment_commitment_bin[3,4)
## -0.744339
## installment_commitment_bin[4, Inf)
## -0.971944
## num_dependents_bin[2, Inf)
## -0.527610
## residence_since_bin[2,3)
## -0.833613
## residence_since_bin[3,4)
## -0.634618
## residence_since_bin[4, Inf)
## -0.437017
##
## Degrees of Freedom: 799 Total (i.e. Null); 737 Residual
## Null Deviance: 975.7
## Residual Deviance: 719.5 AIC: 845.5Objek i diatas bisa diganti menjadi angka 2-5, kemudian hasil outputnya disesuaikan dengan urutan yang dimasukan pada objek learner_credit diatas.