Does WOE Transformation Improve Logistic Regression’s Performance?

The Serious Problem Must Be Handled

WOE Transformation and Logistic Regression’s Performance

#=================================
#  State 1: Data Pre-processing
#=================================

# Load một số packages cho data manipulation: 
library(tidyverse)
library(magrittr)

# Import data: 
hmeq <- read.csv("http://www.creditriskanalytics.net/uploads/1/9/5/1/19511601/hmeq.csv")

# Function replaces NA by mean: 
replace_by_mean <- function(x) {
  x[is.na(x)] <- mean(x, na.rm = TRUE)
  return(x)
}

# A function imputes NA observations for categorical variables: 

replace_na_categorical <- function(x) {
  x %>% 
    table() %>% 
    as.data.frame() %>% 
    arrange(-Freq) ->> my_df
  
  n_obs <- sum(my_df$Freq)
  pop <- my_df$. %>% as.character()
  set.seed(29)
  x[is.na(x)] <- sample(pop, sum(is.na(x)), replace = TRUE, prob = my_df$Freq)
  return(x)
}

# Use the two functions: 
df <- hmeq %>% 
  mutate_if(is.factor, as.character) %>% 
  mutate(REASON = case_when(REASON == "" ~ NA_character_, TRUE ~ REASON), 
         JOB = case_when(JOB == "" ~ NA_character_, TRUE ~ JOB)) %>%
  mutate_if(is_character, as.factor) %>% 
  mutate_if(is.numeric, replace_by_mean) %>% 
  mutate_if(is.factor, replace_na_categorical)

# Check again missing cases: 

df %>% sapply(function(x) {sum(is.na(x))})

##     BAD    LOAN MORTDUE   VALUE  REASON     JOB     YOJ   DEROG  DELINQ 
##       0       0       0       0       0       0       0       0       0 
##   CLAGE    NINQ    CLNO DEBTINC 
##       0       0       0       0

# Phân chia dữ liệu: 
set.seed(2)
df_train <- df %>% group_by(BAD) %>% sample_frac(0.5, replace = FALSE)
df_test <- setdiff(df, df_train)


#====================================================================
#  Kịch bản 1: So sánh Logistic Regression với biến nguyên bản 
#  và WOE Transformation. Tham khảo thêm: 
#  https://cran.r-project.org/web/packages/scorecard/scorecard.pdf
#====================================================================


# Load package cho binning WOE: 
library(scorecard)

# Thực hiện binning dữ liệu: 
bins <- woebin(df_train, y = "BAD")

## [INFO] creating woe binning ...

# Thực hiện WOE Transformation: 
df_train_woe <- woebin_ply(df_train, bins = bins) %>% 
  mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

## [INFO] converting into woe values ...

df_test_woe <- woebin_ply(df_test, bins = bins) %>% 
  mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

## [INFO] converting into woe values ...

# Thực hiện Logistic với biến được làm WOE Transformation: 
model_full_woe <- glm(BAD ~ ., family = "binomial", data = df_train_woe)

# Kết quả của mô hình: 
summary(model_full_woe)

## 
## Call:
## glm(formula = BAD ~ ., family = "binomial", data = df_train_woe)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.0877   0.1436   0.2543   0.4713   2.8750  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.38655    0.06273  22.102  < 2e-16 ***
## LOAN_woe    -0.59605    0.17417  -3.422 0.000621 ***
## MORTDUE_woe -0.64188    0.21875  -2.934 0.003343 ** 
## VALUE_woe   -0.53917    0.15658  -3.443 0.000574 ***
## REASON_woe  -0.41469    0.49978  -0.830 0.406685    
## JOB_woe     -0.65059    0.19607  -3.318 0.000906 ***
## YOJ_woe     -1.01467    0.21061  -4.818 1.45e-06 ***
## DEROG_woe   -0.60753    0.10027  -6.059 1.37e-09 ***
## DELINQ_woe  -0.96626    0.08067 -11.978  < 2e-16 ***
## CLAGE_woe   -0.74682    0.11984  -6.232 4.61e-10 ***
## NINQ_woe    -0.45039    0.14699  -3.064 0.002183 ** 
## CLNO_woe    -1.14173    0.19179  -5.953 2.63e-09 ***
## DEBTINC_woe -0.92948    0.04861 -19.121  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.8  on 2979  degrees of freedom
## Residual deviance: 1837.2  on 2967  degrees of freedom
## AIC: 1863.2
## 
## Number of Fisher Scoring iterations: 6

# Viết hàm tính toán ROC/AUC: 

library(pROC)
my_roc_fun <- function(model_selected, df_test_selected) {
  my_roc <- roc(df_test_selected$BAD, 
                predict(model_selected, df_test_selected %>% select(-BAD), 
                        type = "response"))
  return(my_roc$auc)
  
}

# Chuẩn bị dữ liệu cho Logistic mà biến là nguyên bản: 
df_train_ori <- df_train %>% 
  mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())
  
df_test_ori <- df_test %>% 
  mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())


# Thực hiện Logistic với biến nguyên bản: 
model_full_ori <- glm(BAD ~ ., family = "binomial", data = df_train_ori)

# Xem kết quả: 
summary(model_full_ori)

## 
## Call:
## glm(formula = BAD ~ ., family = "binomial", data = df_train_ori)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.9693   0.2547   0.4212   0.5955   2.1117  
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    2.718e+00  3.780e-01   7.190 6.47e-13 ***
## LOAN           1.157e-05  5.643e-06   2.051  0.04030 *  
## MORTDUE        4.375e-06  2.111e-06   2.072  0.03824 *  
## VALUE         -3.390e-06  1.629e-06  -2.081  0.03740 *  
## REASONHomeImp -3.263e-01  1.190e-01  -2.741  0.00613 ** 
## JOBOffice      4.779e-01  2.091e-01   2.286  0.02227 *  
## JOBOther      -2.564e-01  1.639e-01  -1.564  0.11777    
## JOBProfExe    -8.934e-02  1.905e-01  -0.469  0.63915    
## JOBSales      -8.338e-01  3.467e-01  -2.405  0.01618 *  
## JOBSelf       -5.574e-01  3.063e-01  -1.820  0.06882 .  
## YOJ            1.527e-02  8.327e-03   1.834  0.06671 .  
## DEROG         -5.373e-01  7.022e-02  -7.650 2.00e-14 ***
## DELINQ        -7.496e-01  5.317e-02 -14.098  < 2e-16 ***
## CLAGE          6.341e-03  7.953e-04   7.973 1.54e-15 ***
## NINQ          -1.567e-01  2.958e-02  -5.297 1.17e-07 ***
## CLNO           1.720e-02  6.113e-03   2.813  0.00490 ** 
## DEBTINC       -5.923e-02  8.743e-03  -6.775 1.24e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.8  on 2979  degrees of freedom
## Residual deviance: 2303.6  on 2963  degrees of freedom
## AIC: 2337.6
## 
## Number of Fisher Scoring iterations: 5

# So sánh AUC/ROC: 
my_roc_fun(model_full_woe, df_test_woe)

## Area under the curve: 0.8917

my_roc_fun(model_full_ori, df_train_ori)

## Area under the curve: 0.8071

# Viết hàm extract ra ROC/AUC của nhiều lần thử nghiệm cho mục đích so sánh:

my_roc_for_comparision <- function(so_lan_thu) {
  
  auc_woe <- c() 
  auc_ori <- c()
  
  for (i in 1:so_lan_thu) {
    
    # Chuẩn bị dữ liệu: 
    set.seed(i)
    df_train <- df %>% group_by(BAD) %>% sample_frac(0.5, replace = FALSE)
    df_test <- setdiff(df, df_train)
    
    # Thực hiện binning dữ liệu: 
    bins <- woebin(df_train, y = "BAD")
    
    # Thực hiện WOE Transformation: 
    df_train_woe <- woebin_ply(df_train, bins = bins) %>% 
      mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())
    
    df_test_woe <- woebin_ply(df_test, bins = bins) %>% 
      mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())
    
    # Thực hiện Logistic với biến được làm WOE Transformation: 
    model_full_woe <- glm(BAD ~ ., family = "binomial", data = df_train_woe)
    
    auc_woe_i <- my_roc_fun(model_full_woe, df_test_woe)
    auc_woe <- c(auc_woe, auc_woe_i)
    
    
    # Chuẩn bị dữ liệu cho Logistic mà biến là nguyên bản: 
    df_train_ori <- df_train %>% 
      mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())
    
    df_test_ori <- df_test %>% 
      mutate(BAD = case_when(BAD == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())
    
    # Thực hiện Logistic với biến nguyên bản: 
    model_full_ori <- glm(BAD ~ ., family = "binomial", data = df_train_ori)
    auc_ori_i <- my_roc_fun(model_full_ori, df_test_ori)
    auc_ori <- c(auc_ori, auc_ori_i)
    
  }
  
  return(data.frame(AUC_woe = auc_woe, AUC_ori = auc_ori))
}


# Thử nghiệm trên 10 lần chạy mẫu. Cả 10 lần thử nghiệm có thể thấy
# ROC/AUC của mô hình Logistic với biến được thực hiện WOE Transformation
# là cao hơn: 

my_roc_for_comparision(so_lan_thu = 10) %>% knitr::kable()

## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ... 
## [INFO] creating woe binning ... 
## [INFO] converting into woe values ... 
## [INFO] converting into woe values ...

AUC_woe	AUC_ori
0.8917636	0.7982665
0.8916594	0.7856294
0.8954537	0.8020408
0.8873914	0.7834667
0.8755457	0.7862284
0.8910502	0.7986259
0.8873203	0.7965386
0.8813748	0.7905925
0.8852872	0.7858239
0.8801638	0.7941004