AUC or IV Criterion - Which Method is Better for Feature Engineering?

R for Fun

# Load some packages: 
library(tidyverse)
library(caret)
library(pROC)

# Load data: 
data("GermanCredit")
df <- GermanCredit

# Set predictors and response: 
response <- "Class"
predictors <- names(df %>% select(-response))

#===============================================================
#  Scenario 1: ROC/AUC as a criterion for feature engineering
#===============================================================

# Split our data: 

set.seed(1)
id <- createDataPartition(y = df %>% pull(response), p = 0.7, list = FALSE)
train <- df[id, ]
test <- df[-id, ]

# Function extracts ROC/AUC for a predictor selected: 

returnROC_AUC <- function(predictor_selected) {
  
  f <- as.formula(paste0(response, " ~ ", predictor_selected))
  logit <- glm(f, family = "binomial", data = train)
  prob_pred <- predict(logit, test, type = "response")
  my_auc <- roc(test %>% pull(response), prob_pred)$auc %>% as.numeric()
  return(tibble(predictor = predictor_selected, auc = my_auc))
  
}


# ROC/AUC by a given predictor: 
do.call("bind_rows", lapply(predictors, returnROC_AUC)) %>% 
  arrange(-auc) -> df_auc

# Function extracts ROC/AUC on test data: 

returnROC_AUCTestData <- function(predictor_selected) {
  f <- as.formula(paste0(response, " ~ ", paste(predictor_selected, collapse = " + ")))
  logit <- glm(f, family = "binomial", data = train)
  prob_pred <- predict(logit, test, type = "response")
  my_auc <- roc(test$Class, prob_pred)$auc %>% as.numeric()
  return(my_auc)
  
}


# Calculate our AUC: 
AUC_All <- returnROC_AUCTestData(predictor_selected = predictors)
AUC_Variables55 <- returnROC_AUCTestData(predictor_selected = df_auc %>% filter(auc > 0.55) %>% pull(predictor))

#==============================================================================
#  Scenario 2: Information Value (IV) as a criterion for feature engineering
#==============================================================================

# Before conducting IV procedure we must convert response variable to numeric: 

train %>% 
  mutate(Class = case_when(Class == "Bad" ~ 1, TRUE ~ 0)) -> train_converted

test %>% 
  mutate(Class = case_when(Class == "Bad" ~ 1, TRUE ~ 0)) -> test_converted


# Load scorecard package: 
library(scorecard)

# Calculate Information Values (IV): 
info_values <- iv(train_converted, y = "Class", positive = "Class|1")

# Variables with IV >= 0.1: 
info_values %>% 
  filter(info_value >= 0.1) %>% 
  arrange(info_value) %>% 
  mutate(info_value = round(info_value, 3), variable = factor(variable, levels = variable)) -> df_iv_over1


# Plot: 
df_iv_over1 %>% 
  ggplot(aes(variable, info_value)) + 
  geom_col(fill = "#377eb8") + 
  coord_flip() + 
  geom_text(aes(label = info_value), hjust = 1.1, size = 5, color = "white") + 
  labs(title = "Figure 1: Variables with Information Value (IV) >= 0.1", 
       x = NULL, y = "Information Value (IV)") + 
  scale_y_continuous(expand = c(0, 0), limits = c(0, 0.5)) + 
  theme_minimal() + 
  theme(panel.grid.major.y = element_blank()) + 
  theme(plot.margin = unit(c(1, 1, 1, 1), "cm")) 

# Binning variables with IV >= 0.1  : 

bins <- woebin(train_converted %>% select(df_iv_over1$variable, response), y = "Class",  positive = "Class|1")

## [INFO] creating woe binning ...

# Conduct WoE transformation: 

df_train_woe <- woebin_ply(train_converted %>% select(df_iv_over1$variable, response), bins = bins) %>% 
  mutate(Class = case_when(Class == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

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

df_test_woe <- woebin_ply(test_converted %>% select(df_iv_over1$variable, response), bins = bins) %>% 
  mutate(Class = case_when(Class == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

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

# Train Logistic Regression with WoE-transfored predictors: 

logitWoE <- glm(Class ~ ., family = "binomial", data = df_train_woe)

# Calculate ROC/AUC: 

prob_predWoE <- predict(logitWoE, df_test_woe, type = "response")
roc(df_test_woe$Class, prob_predWoE)$auc 

## Area under the curve: 0.6516

#=====================================================
#   Scenario 3: Usel all WoE-transformed predictors
#=====================================================


# Binning all variables: 

bins_all <- woebin(train_converted, y = "Class",  positive = "Class|1")

## [INFO] creating woe binning ...

# Conduct WoE transformation: 

df_train_woeAll <- woebin_ply(train_converted, bins = bins_all) %>% 
  mutate(Class = case_when(Class == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

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

df_test_woeAll <- woebin_ply(test_converted, bins = bins_all) %>% 
  mutate(Class = case_when(Class == 1 ~ "Bad", TRUE ~ "Good") %>% as.factor())

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

# Train Logistic Regression with WoE-transformed predictors: 

logitWoE_All <- glm(Class ~ ., family = "binomial", data = df_train_woeAll)

# Calculate ROC/AUC: 

prob_predWoE_All <- predict(logitWoE_All, df_test_woeAll, type = "response")
AUC_WoETran <- roc(df_test_woeAll$Class, prob_predWoE_All)$auc %>% as.numeric()

# Compare AUC results:
df_results <- tibble(Method = c("All Variables", "AUC 0.55", "WoE Tran"), 
                     AUC = c(AUC_All, AUC_Variables55, AUC_WoETran))

knitr::kable(df_results %>% mutate(AUC = round(AUC, 3)) %>% arrange(-AUC))

Method	AUC
AUC 0.55	0.799
WoE Tran	0.777
All Variables	0.750