Credit Scoring
Bagus Sartono
April 6, 2020
Bahan pembelajaran KAPITA SELEKTA
Topik: Application Scoring (untuk kasus kredit)
pada halaman ini, akan didiskusikan bagaimana memperoleh scorecard dari model application scoring sederhana. Akan dipaparkan tahap demi tahap, kecuali tahapan validasi model. Pembaca dapat melihat sumber lain tentang validasi model yang sejenis dengan pemodelan secara umum.
Tahapan umum
- Data Gathering and Data Cleansing (diasumsikan sudah terlaksana)
- Exploration and Feature Engineering
- Discretization
- Weight of Evidence
- Variable Selection menggunakan Information Value
- Modeling menggunakan Logistic Regression
- Validating
- Score Scaling
Tahap 1. Data Gathering and Data Cleansing
Diasumsikan sudah terlaksana. Data tersedia pada file datascoring.csv
datascoring <- read.csv("D:/datascoring.csv")
names(datascoring)## [1] "ID" "Age" "Gender"
## [4] "Residence.Ownership" "number.of.dependants" "status"head(datascoring)## ID Age Gender Residence.Ownership number.of.dependants status
## 1 1 41 FEMALE OTHERS 0 GOOD
## 2 2 36 MALE OWNED 5 GOOD
## 3 3 40 FEMALE RENT 4 BAD
## 4 4 30 FEMALE OWNED 4 GOOD
## 5 5 37 MALE OWNED 4 GOOD
## 6 6 38 MALE RENT 1 GOODData berisi empat prediktor: * Age * Gender * Residence.Ownership * number.of.dependants
Variabel respon adalah status
Tahap 2. Exploration and Feature Engineering
Discretization
Dari empat prediktor yang ada, variabel yang numerik adalah Age dan number.of.dependants, sehingga keduanya adalah kandidat untuk dilakukan diskretisasi. Kita lakukan dulu untuk variabel Age. Perhatikan sebaran datanya adalah sebagai berikut.
##melihat sebaran variabel age
hist(datascoring$Age,breaks=20)
Variabel Age kira-kira berkisar antara 16 hingga 60 tahun. Andaikan kita buat dalam beberapa grup sebagai berikut: * kurang dari 25 tahun * 26 s.d 30 tahun * 31 s.d 35 tahun * 36 s.d 40 tahun * 41 s.d 45 tahun * 46 tahun ke atas
Progarm yang dapat digunakan adalah sebagai berikut. Diskretisasi dapat dilakukan mengggunakan fungsi cut() dengan menyebutkan breakpoints yang diinginkan. Program di bawah ini selanjutnya juga menampilkan tabel frekuensi setiap kelompok usia.
#binning variabel age
datascoring$agegroup <- cut(datascoring$Age, breaks = c(16,25,30,35,40,45,59), labels=1:6, include.lowest = T)
tabel_usia <- cbind(table(datascoring$agegroup),NA)
tabel_usia[,2] <- tabel_usia[,1]/sum(tabel_usia[,1])
dimnames(tabel_usia) <- list(1:6,c("n","ColPctn"))
tabel_usia## n ColPctn
## 1 134 0.05851528
## 2 394 0.17205240
## 3 680 0.29694323
## 4 671 0.29301310
## 5 311 0.13580786
## 6 100 0.04366812Variabel number of dependants merupakan variabel numerik tapi sudah berbentuk diskret yang nilainya 0, 1, 2, …, 5 sehingga tidak diperlukan proses diskretisasi.
Selanjutnya kita akan hitung nilai WoE untuk setiap kategori dari masing-masing variabel prediktor.
Weight of Evidence
Nilai WoE untuk kategori variabel Gender
library(InformationValue)## Warning: package 'InformationValue' was built under R version 3.5.3#WOE variabel gender
WOE_gender <- WOE(datascoring$Gender,as.numeric(datascoring$status))
Tabel_WOE_gender <- WOETable(datascoring$Gender,as.numeric(datascoring$status))
Tabel_WOE_gender## CAT GOODS BADS TOTAL PCT_G PCT_B WOE IV
## 1 FEMALE 156 769 925 0.2071713 0.5003253 -0.8817124 0.2584775
## 2 MALE 597 768 1365 0.7928287 0.4996747 0.4616499 0.1353345Nilai WoE untuk kategori variabel agegroup
WOE_agegroup <- WOE(datascoring$agegroup,as.numeric(datascoring$status))
Tabel_WOE_agegroup <- WOETable(datascoring$agegroup,as.numeric(datascoring$status))
Tabel_WOE_agegroup## CAT GOODS BADS TOTAL PCT_G PCT_B WOE IV
## 1 1 57 77 134 0.07569721 0.05009759 0.41276836 1.056671e-02
## 2 2 137 257 394 0.18193891 0.16720885 0.08442736 1.243620e-03
## 3 3 244 436 680 0.32403718 0.28366949 0.13304850 5.370862e-03
## 4 4 202 469 671 0.26826029 0.30513988 -0.12881256 4.750554e-03
## 5 5 101 210 311 0.13413015 0.13662980 -0.01846450 4.615482e-05
## 6 6 12 88 100 0.01593625 0.05725439 -1.27890765 5.284208e-02Nilai WoE untuk kategori variabel Residence Ownership
WOE_residence <- WOE(datascoring$Residence.Ownership,as.numeric(datascoring$status))
Tabel_WOE_residence <- WOETable(datascoring$Residence.Ownership,as.numeric(datascoring$status))
Tabel_WOE_residence## CAT GOODS BADS TOTAL PCT_G PCT_B WOE IV
## 1 OTHERS 88 83 171 0.11686587 0.05400130 0.7720187 0.048532624
## 2 OWNED 156 1071 1227 0.20717131 0.69681197 -1.2129695 0.593919206
## 3 PARENTS 75 111 186 0.09960159 0.07221861 0.3214804 0.008803094
## 4 RENT 434 272 706 0.57636122 0.17696812 1.1807650 0.471589390Nilai WoE untuk kategori variabel Number of Dependants
WOE_dependants <- WOE(factor(datascoring$number.of.dependants),as.numeric(datascoring$status))
Tabel_WOE_dependants <- WOETable(factor(datascoring$number.of.dependants),as.numeric(datascoring$status))
Tabel_WOE_dependants## CAT GOODS BADS TOTAL PCT_G PCT_B WOE IV
## 1 0 88 445 533 0.1168659 0.28952505 -0.9072150 0.156638989
## 2 1 133 358 491 0.1766268 0.23292128 -0.2766613 0.015574498
## 3 2 88 217 305 0.1168659 0.14118412 -0.1890380 0.004597075
## 4 3 117 214 331 0.1553785 0.13923227 0.1097204 0.001771570
## 5 4 172 154 326 0.2284197 0.10019519 0.8240644 0.105665219
## 6 5 155 149 304 0.2058433 0.09694209 0.7530013 0.082002747Variable Selection menggunakan Information Value
Nilai IV untuk variabel gender
sum(Tabel_WOE_gender$IV)## [1] 0.393812Nilai IV untuk variabel agegroup
sum(Tabel_WOE_agegroup$IV)## [1] 0.07481998Nilai IV untuk variabel residence ownership
sum(Tabel_WOE_residence$IV)## [1] 1.122844Nilai IV untuk variabel number of dependants
sum(Tabel_WOE_dependants$IV)## [1] 0.3662501Tahap 3. Modeling menggunakan Logistic Regression
Membuat model dengan WoE sebagai prediktor (bukan variabel aslinya)
datascoring.WOE <- data.frame(WOE_gender,WOE_agegroup,WOE_residence, WOE_dependants,status=datascoring$status)
##menentukan bobot setiap variabel
modelWOE <- glm(status~WOE_gender+WOE_agegroup+WOE_residence+WOE_dependants, data=datascoring.WOE,family="binomial")Bobot dari setiap prediktor adalah sebagai berikut
modelWOE$coefficients## (Intercept) WOE_gender WOE_agegroup WOE_residence WOE_dependants
## 0.717695 -1.498559 -1.605527 -1.299587 -1.603643Tahap 4. Validating
pada ilustrasi ini tidak kita lakukan…
Tahap 5. Score Scaling
tabel_WOE <- rbind(cbind(input="WOE Gender", Tabel_WOE_gender[,c(1,7)]), cbind(input="WOE Age Group", Tabel_WOE_agegroup[,c(1,7)]), cbind(input="WOE Residence", Tabel_WOE_residence[,c(1,7)]), cbind(input="WOE Dependants", Tabel_WOE_dependants[,c(1,7)]))
factor_value <- 20/log(2)
offset_value <- 600-factor_value*log(50)
beta <- modelWOE$coefficients
betawoe <- rep(beta[2:5],times=as.vector(table(tabel_WOE[,1])))
tabel_WOE[,4] <- round((betawoe*tabel_WOE[,3] + beta[1]/4) * factor_value + offset_value/4)
colnames(tabel_WOE)[4] <- "score"Scorecard yang dihasilkan
tabel_WOE## input CAT WOE score
## 1 WOE Gender FEMALE -0.88171245 165
## 2 WOE Gender MALE 0.46164990 107
## 3 WOE Age Group 1 0.41276836 108
## 4 WOE Age Group 2 0.08442736 123
## 5 WOE Age Group 3 0.13304850 121
## 6 WOE Age Group 4 -0.12881256 133
## 7 WOE Age Group 5 -0.01846450 128
## 8 WOE Age Group 6 -1.27890765 186
## 9 WOE Residence OTHERS 0.77201872 98
## 10 WOE Residence OWNED -1.21296955 172
## 11 WOE Residence PARENTS 0.32148043 115
## 12 WOE Residence RENT 1.18076498 83
## 13 WOE Dependants 0 -0.90721495 169
## 14 WOE Dependants 1 -0.27666134 140
## 15 WOE Dependants 2 -0.18903802 136
## 16 WOE Dependants 3 0.10972044 122
## 17 WOE Dependants 4 0.82406439 89
## 18 WOE Dependants 5 0.75300133 92