Measuring Model Performance Using a Gains Table

R
Credit Risk Analytics
Model Evaluation
Published

January 28, 2024

Measuring Model Performance Using a Gains Table

In credit risk modeling, analysts often use a tool called a gains table (or KS table) to measure and quantify the performance of classification models. This post explores how to build and interpret such a table using R.

What is a Gains Table?

A gains table discretizes the population (typically a test or validation set) into groups based on the model’s output (probability, log odds, or scores). Usually, each group represents 10% of the total population (deciles). The table then presents summary statistics for each group and analyzes the cumulative distributions of events (defaults) and non-events to quantify the model’s performance.

Required Libraries

# Load required packages
library(dplyr)
library(magrittr)
library(knitr)
library(scales)

Sample Dataset

We’ll use a sample from the Lending Club dataset, which contains information about loans and their outcomes.

# Load the sample data
sample <- read.csv("https://bit.ly/42ypcnJ")

# Check dimensions
dim(sample)
[1] 10000   153

Defining the Target Variable

First, we need to create a target (outcome) variable to model. Since this is a credit risk use case, we’ll identify borrowers who defaulted on their payments.

# Check unique loan statuses
unique(sample$loan_status)
[1] "Fully Paid"                                         
[2] "Current"                                            
[3] "Charged Off"                                        
[4] "Late (31-120 days)"                                 
[5] "Late (16-30 days)"                                  
[6] "In Grace Period"                                    
[7] "Does not meet the credit policy. Status:Fully Paid" 
[8] "Does not meet the credit policy. Status:Charged Off"
# Define "bad" loans as those that are charged off
codes <- c("Charged Off", "Does not meet the credit policy. Status:Charged Off")

# Create a binary flag for defaults
sample %<>% mutate(bad_flag = ifelse(loan_status %in% codes, 1, 0))

# Check overall event rates
sample %>% 
  summarise(events = sum(bad_flag == 1), 
            non_events = sum(bad_flag == 0)) %>% 
  mutate(event_rate = events/(events + non_events))
  events non_events event_rate
1   1162       8838     0.1162

Building a Simple Model

Next, let’s build a quick model, the output of which we’ll use to create the gains table.

# Replace NA values with a default value
sample[is.na(sample)] <- -1

# Clean the data
sample %<>% 
  # Remove cases where home ownership and payment plan are not reported
  filter(!home_ownership %in% c("", "NONE"),
         pymnt_plan != "") %>% 
  # Convert categorical variables to factors
  mutate(home_ownership = factor(home_ownership), 
         pymnt_plan = factor(pymnt_plan))

# Train-test split (70-30)
idx <- sample(1:nrow(sample), size = 0.7 * nrow(sample), replace = FALSE)
train <- sample[idx,]
test <- sample[-idx,]
# Build a logistic regression model
mdl <- glm(
  formula = bad_flag ~ 
    loan_amnt + term + mths_since_last_delinq + total_pymnt + 
    home_ownership + acc_now_delinq + 
    inq_last_6mths + delinq_amnt + 
    mths_since_last_record + mths_since_recent_revol_delinq + 
    mths_since_last_major_derog + mths_since_recent_inq + 
    mths_since_recent_bc + num_accts_ever_120_pd,
  family = "binomial", 
  data = train
)

# Generate predictions on the test set
test$pred <- predict(mdl, newdata = test)

Creating the Gains Table

Now let’s build the gains table step by step:

Step 1: Discretize Predictions into Bins

# Create deciles based on model predictions
q <- quantile(test$pred, probs = seq(0, 1, length.out = 11))

# Add bins to test dataset
test$bins <- cut(test$pred, breaks = q, include.lowest = TRUE, 
                right = TRUE, ordered_result = TRUE)

# Check the bin levels (note they're in increasing order)
levels(test$bins)
 [1] "[-5.33,-3.34]" "(-3.34,-2.92]" "(-2.92,-2.66]" "(-2.66,-2.45]"
 [5] "(-2.45,-2.25]" "(-2.25,-2.07]" "(-2.07,-1.85]" "(-1.85,-1.6]" 
 [9] "(-1.6,-1.24]"  "(-1.24,0.677]"

Step 2: Calculate Basic Statistics for Each Bin

# Create initial gains table with counts
gains_table <- test %>% 
  group_by(bins) %>% 
  summarise(total = n(), 
            events = sum(bad_flag == 1), 
            non_events = sum(bad_flag == 0))

# Add event rate column
gains_table %<>%
  mutate(event_rate = percent(events / total, 0.1, 100))

# Display the table
kable(gains_table)
bins total events non_events event_rate
[-5.33,-3.34] 300 3 297 1.0%
(-3.34,-2.92] 300 7 293 2.3%
(-2.92,-2.66] 300 12 288 4.0%
(-2.66,-2.45] 300 20 280 6.7%
(-2.45,-2.25] 300 26 274 8.7%
(-2.25,-2.07] 300 42 258 14.0%
(-2.07,-1.85] 300 47 253 15.7%
(-1.85,-1.6] 300 61 239 20.3%
(-1.6,-1.24] 300 59 241 19.7%
(-1.24,0.677] 300 63 237 21.0%

Step 3: Add Distribution Metrics

# Add population percentage and cumulative distributions
gains_table %<>%
  mutate(pop_pct = percent(total/sum(total), 0.1, 100), 
         
         # Calculate cumulative percentages
         c.events_pct = cumsum(events) / sum(events),
         c.non_events_pct = cumsum(non_events) / sum(non_events))

# Display the updated table
kable(gains_table)
bins total events non_events event_rate pop_pct c.events_pct c.non_events_pct
[-5.33,-3.34] 300 3 297 1.0% 10.0% 0.0088235 0.1116541
(-3.34,-2.92] 300 7 293 2.3% 10.0% 0.0294118 0.2218045
(-2.92,-2.66] 300 12 288 4.0% 10.0% 0.0647059 0.3300752
(-2.66,-2.45] 300 20 280 6.7% 10.0% 0.1235294 0.4353383
(-2.45,-2.25] 300 26 274 8.7% 10.0% 0.2000000 0.5383459
(-2.25,-2.07] 300 42 258 14.0% 10.0% 0.3235294 0.6353383
(-2.07,-1.85] 300 47 253 15.7% 10.0% 0.4617647 0.7304511
(-1.85,-1.6] 300 61 239 20.3% 10.0% 0.6411765 0.8203008
(-1.6,-1.24] 300 59 241 19.7% 10.0% 0.8147059 0.9109023
(-1.24,0.677] 300 63 237 21.0% 10.0% 1.0000000 1.0000000

Step 4: Add Performance Metrics

# Add KS statistic, capture rate, and cumulative event rate
gains_table %<>%
  mutate(
    # KS statistic (difference between cumulative distributions)
    ks = round(abs(c.events_pct - c.non_events_pct), 2), 
    
    # Capture rate (percentage of total events captured)
    cap_rate = percent(cumsum(events)/sum(events), 1, 100), 
    
    # Cumulative event rate
    c_event_rate = percent(cumsum(events)/cumsum(total), 0.1, 100), 
    
    # Format percentage columns
    c.events_pct = percent(c.events_pct, 0.1, 100),
    c.non_events_pct = percent(c.non_events_pct, 0.1, 100))

# Display the final table
kable(gains_table)
bins total events non_events event_rate pop_pct c.events_pct c.non_events_pct ks cap_rate c_event_rate
[-5.33,-3.34] 300 3 297 1.0% 10.0% 0.9% 11.2% 0.10 1% 1.0%
(-3.34,-2.92] 300 7 293 2.3% 10.0% 2.9% 22.2% 0.19 3% 1.7%
(-2.92,-2.66] 300 12 288 4.0% 10.0% 6.5% 33.0% 0.27 6% 2.4%
(-2.66,-2.45] 300 20 280 6.7% 10.0% 12.4% 43.5% 0.31 12% 3.5%
(-2.45,-2.25] 300 26 274 8.7% 10.0% 20.0% 53.8% 0.34 20% 4.5%
(-2.25,-2.07] 300 42 258 14.0% 10.0% 32.4% 63.5% 0.31 32% 6.1%
(-2.07,-1.85] 300 47 253 15.7% 10.0% 46.2% 73.0% 0.27 46% 7.5%
(-1.85,-1.6] 300 61 239 20.3% 10.0% 64.1% 82.0% 0.18 64% 9.1%
(-1.6,-1.24] 300 59 241 19.7% 10.0% 81.5% 91.1% 0.10 81% 10.3%
(-1.24,0.677] 300 63 237 21.0% 10.0% 100.0% 100.0% 0.00 100% 11.3%

Creating a Reusable Function

Let’s encapsulate all the above steps into a single function that can be reused for any binary classification model:

gains_table <- function(act, pred, increasing = TRUE, nBins = 10) {
  
  # Create bins based on predictions
  q <- quantile(pred, probs = seq(0, 1, length.out = nBins + 1))
  bins <- cut(pred, breaks = q, include.lowest = TRUE, right = TRUE, ordered_result = TRUE)
  
  df <- data.frame(act, pred, bins)
  
  df %>% 
    # Group by bins and calculate statistics
    group_by(bins) %>% 
    summarise(total = n(), 
              events = sum(act == 1), 
              non_events = sum(act == 0)) %>% 
    mutate(event_rate = percent(events / total, 0.1, 100)) %>% 
    
    # Sort the table based on the 'increasing' parameter
    {if(increasing == TRUE) {
      arrange(., bins)
    } else {
      arrange(., desc(bins))
    }} %>% 
    
    # Add all performance metrics
    mutate(pop_pct = percent(total/sum(total), 0.1, 100), 
           c.events_pct = cumsum(events) / sum(events),
           c.non_events_pct = cumsum(non_events) / sum(non_events), 
           ks = round(abs(c.events_pct - c.non_events_pct), 2), 
           cap_rate = percent(cumsum(events)/sum(events), 1, 100), 
           c_event_rate = percent(cumsum(events)/cumsum(total), 0.1, 100), 
           c.events_pct = percent(c.events_pct, 0.1, 100),
           c.non_events_pct = percent(c.non_events_pct, 0.1, 100))
}

Using the Function

# Generate a gains table with bins in descending order
tab <- gains_table(test$bad_flag, test$pred, FALSE, 10)
kable(tab)
bins total events non_events event_rate pop_pct c.events_pct c.non_events_pct ks cap_rate c_event_rate
(-1.24,0.677] 300 63 237 21.0% 10.0% 18.5% 8.9% 0.10 19% 21.0%
(-1.6,-1.24] 300 59 241 19.7% 10.0% 35.9% 18.0% 0.18 36% 20.3%
(-1.85,-1.6] 300 61 239 20.3% 10.0% 53.8% 27.0% 0.27 54% 20.3%
(-2.07,-1.85] 300 47 253 15.7% 10.0% 67.6% 36.5% 0.31 68% 19.2%
(-2.25,-2.07] 300 42 258 14.0% 10.0% 80.0% 46.2% 0.34 80% 18.1%
(-2.45,-2.25] 300 26 274 8.7% 10.0% 87.6% 56.5% 0.31 88% 16.6%
(-2.66,-2.45] 300 20 280 6.7% 10.0% 93.5% 67.0% 0.27 94% 15.1%
(-2.92,-2.66] 300 12 288 4.0% 10.0% 97.1% 77.8% 0.19 97% 13.8%
(-3.34,-2.92] 300 7 293 2.3% 10.0% 99.1% 88.8% 0.10 99% 12.5%
[-5.33,-3.34] 300 3 297 1.0% 10.0% 100.0% 100.0% 0.00 100% 11.3%

Interpreting the Gains Table

A gains table provides several key insights into model performance:

  1. Monotonicity: The event rates should consistently increase (or decrease) across bins. This confirms that the model effectively rank-orders risk.

  2. Bin Consistency: If bin sizes are not consistent (ideally ~10% each), it suggests the model is assigning the same output/score to many borrowers (clumping), which could pose issues when deciding cutoffs.

  3. KS Statistic: The maximum value of the KS column indicates the model’s discriminatory power. A higher value (closer to 1) indicates better separation between good and bad borrowers.

  4. Capture Rate: Shows what percentage of all bad accounts are captured at each cutoff point.

  5. Cumulative Event Rate: Indicates the bad rate among all accounts up to that bin, useful for setting approval thresholds.

Practical Applications

In credit risk management, the gains table helps with:

  1. Setting Cutoffs: Identifying appropriate score thresholds for approving or rejecting applications.

  2. Strategy Development: Creating tiered strategies (e.g., approve, review, decline) based on risk levels.

  3. Performance Monitoring: Tracking model performance over time by comparing actual vs. expected distributions.

  4. Model Comparison: Evaluating different models by comparing their KS statistics and capture rates.

The gains table is a powerful tool for evaluating binary classification models, especially in credit risk applications. By providing a structured view of how well a model separates good and bad cases across the score distribution, it helps analysts make informed decisions about model quality and operational implementation.