Starter Code

This section provides a brief example of building a model and calculating a confusion matrix at a particular decision threshold. Most of the code in this section is copied from a vignette for the probably⁹ package and will serve as starter code for my examples. I provide brief descriptions of the code chunks but recommend reading the source for explanations on the steps.

(If you are familiar with tidymodels and modeling in classification problems you might skip to Weighting by Classification Outcomes.)

Minor transformations and select relevant columns:

lending_club <- lending_club %>%
  mutate(Class = relevel(Class, "good")) %>% 
  select(Class, annual_inc, verification_status, sub_grade, funded_amnt)

Training / Testing split:

set.seed(123)
split <- rsample::initial_split(lending_club, prop = 0.75)

lending_train <- rsample::training(split)
lending_test  <- rsample::testing(split)

Specify and build model:

logi_reg <- logistic_reg()
logi_reg_glm <- logi_reg %>% 
  set_engine("glm")

logi_reg_fit <- fit(
  logi_reg_glm,
  formula = Class ~ annual_inc + verification_status + sub_grade,
  data = lending_train
)

Add predictions to test set:

predictions <- logi_reg_fit %>%
  predict(new_data = lending_test, type = "prob")

lending_test_pred <- bind_cols(predictions, lending_test)

Use probably::make_two_class_pred() to make hard predictions at a threshold of 0.50:

hard_pred_0.5 <- lending_test_pred %>%
  mutate(.pred = probably::make_two_class_pred(.pred_good,
                                               levels(Class),
                                               threshold = 0.5) %>% 
           as.factor(c("good", "bad"))
         ) %>%
  select(Class, contains(".pred"))

After we’ve made class predictions we can make a confusion matrix¹⁰. Use yardstick::conf_mat() to get a confusion matrix for the class predictions:

conf_mat_0.5 <- yardstick::conf_mat(hard_pred_0.5, Class, .pred)

conf_mat_0.5 %>% autoplot(type = "heatmap")

We could also call summary(conf_mat_0.5) to calculate common metrics at this decision threshold.

Custom function:

I will load in a function conf_mat_weighted() that works similarly to yardsitck::conf_mat() but can handle observation weights (which will come into play in Weighting by Observations).

# source conf_mat_weighted() which is similar to yardstick::conf_mat() but also
# has the possibility of handling a weights column
devtools::source_gist("https://gist.github.com/brshallo/37d524b82541c2f8540eab39f991830a")

Weighting by Classification Outcomes

For the purposes of this post I will bypass common steps in model evaluation and selection and go straight to using weighting techniques to identify appropriate decision thresholds for a selected model¹¹.

For our loan problem we will use the following weighting scheme for our potential classification outcomes:

• TP: 0.14 (predict a loan is good when it is indeed good)
• FP: 3.10 (predict a loan is good when it is actually bad)
• TN: 0.02 (predict a loan is bad when it is indeed bad)
• FN: 0.06 (predict a loan is bad when it is actually good)

\[ Weights = \left(\begin{array}{cc} 0.14 & 3.10\\0.06 & 0.02 \end{array}\right)\]

There may be asymmetries in business processes associated with the ‘actual’ and the ‘predicted’ states that might explain differences in the value associated with each cell in the confusion matrix¹².

I put the classification outcome weights into a matrix¹³.

outcome_weights <- matrix(
          c(0.14, 3.1,
          0.06, 0.02),
          nrow = 2,
          byrow = TRUE
)

Next I apply these weights to the cells of the confusion matrix.

weight_cells <- function(confusion_matrix, weights = matrix(rep(1, 4), nrow = 2)){
  
  confusion_matrix_output <- confusion_matrix
  confusion_matrix_output$table <- confusion_matrix$table * weights
  confusion_matrix_output
}

conf_mat_0.5_weighted <- weight_cells(conf_mat_0.5, outcome_weights)

conf_mat_0.5_weighted %>% autoplot(type = "heatmap")

Notice how different these values are from those calculated without weighting (shown in Starter Code).

An earlier version of this post included a variety of other performance metrics calculated after weighting by classification outcomes. See Weighted Classification Metrics in the Appendix for a discussion on why these were removed from the body of the post.

Assuming diagonal (correctly predicted) elements represent a gain¹⁴ and off-diagonal elements a loss¹⁵, I will calculate the total value at the 0.50 decision threshold (by taking the difference of the aggregated gains and losses)¹⁶.

sum( (conf_mat_0.5$table * outcome_weights) * matrix(c(1,-1,-1, 1), byrow = TRUE, ncol = 2) )
## [1] -53.96

At a prediction threshold for accepting loans of 0.50, our expected value would be negative.

#' Confusion Matrix at Threshold
#'
#' @param df dataframe containing a column `.pred_good`.
#' @param threshold A value between 0 and 1.
#' @param wt A column that gets passed into `conf_mat_weighted()` if also wanting to give observation weights (default is NULL).
#'
#' @return a confusion matrix
conf_mat_threshold <- function(df = lending_test_pred, 
                               threshold = 0.5, 
                               ...){
  hard_pred <- df %>%
    mutate(.pred = probably::make_two_class_pred(.pred_good,
                                                 levels(Class),
                                                 threshold = threshold) %>%
             as.factor(c("good", "bad"))
           )
  
  conf_mat_weighted(hard_pred, Class, .pred, ...)
}

# get all unique predictions that differ by at least 0.001
thresholds_unique_df <- tibble(threshold = c(0, unique(lending_test_pred$.pred_good), 1)) %>% 
  arrange(threshold) %>%
  mutate(diff_prev = abs(lag(threshold) - threshold),
         diff_prev_small = ifelse((diff_prev) <= 0.001, TRUE,FALSE),
         diff_prev_small = ifelse(is.na(diff_prev_small), FALSE, diff_prev_small)) %>%
  filter(!diff_prev_small) %>% 
  select(threshold)
# compute confusion matrices and weighted confusion matrices
conf_mats_df <- thresholds_unique_df %>% 
  mutate(conf_mat = map(threshold, conf_mat_threshold, df = lending_test_pred)) %>% 
  mutate(conf_mat_weighted = map(conf_mat, weight_cells, weights = outcome_weights))

total_value <- function(weighted_conf_matrix){
  sum(weighted_conf_matrix * matrix(c(1, -1, -1, 1), byrow = TRUE, ncol = 2))
}

conf_mats_value <- conf_mats_df %>% 
  arrange(desc(threshold)) %>% 
  mutate(value = map_dbl(conf_mat_weighted, ~total_value(.x$table)))

conf_mats_value %>% 
  ggplot(aes(x = threshold, y = value))+
  geom_line()

cfm1 <- conf_mats_value %>% 
  arrange(desc(value)) %>% 
  pluck("conf_mat", 1) %>% 
  autoplot(type = "heatmap")+
  coord_fixed()+
  labs(title = "Confusion Matrix",
       subtitle = "Threshold: 0.94")

cfm2 <- conf_mats_value %>% 
  arrange(desc(value)) %>% 
  pluck("conf_mat_weighted", 1) %>% 
  autoplot(type = "heatmap")+
  coord_fixed()+
  labs(title = "Value Weighted Confusion Matrix",
       subtitle = "Threshold: 0.94")

library(patchwork)

cfm1 + cfm2

Weighting by Observations

In the prior section, we used weights to represent the value of classification outcomes. What if we want to account for the value of a specific loan (since higher loan amounts might amplify possible risks)? In this section I will apply the same steps as above but will first weight individual observations²¹ by the funded_amnt column²².

My function conf_mat_weighted() (sourced from gist previously) can handle a value for observation weights. Hence, we will follow the same steps as in Weighting by Classification Outcomes except also supplying wt = funded_amnt.

# get confusion matrices and weighted confusion matrices
conf_mats_df_obs_weights <- thresholds_unique_df %>% 
  mutate(conf_mat = map(threshold, 
                        conf_mat_threshold, 
                        df = lending_test_pred,
                        # funded_amnt provides observation weights
                        wt = funded_amnt)) %>%
  mutate(conf_mat_weighted = map(conf_mat, weight_cells, weights = outcome_weights)) %>%
  mutate(across(contains("conf"), list(metrics = ~map(.x, summary))))

The range of cut-points that maximizes ‘value’ appears similar to that shown in the previous section (when not weighting observations by funded_amnt):

conf_mats_df_obs_weights %>% 
  arrange(desc(threshold)) %>% 
  mutate(value = map_dbl(conf_mat_weighted, ~total_value(.x$table))) %>% 
  discard(is.list) %>% 
  ggplot(aes(x = threshold, y = value))+
  geom_line()

Weights of Observations During and Prior to Modeling

The body of the blog post is focused exclusively on weighting in model evaluation after model training. This section provides a brief overview of other types of weighting that can be used in modeling (as well as references for these topics).

Robert Moser has a helpful blog post, Fraud detection with cost sensitive machine learning, where he differentiates cost dependent classification (weighting after model building) from cost sensitive training (the practice of baking in the costs of classification outcomes²³ into the objective function used during model training²⁴). Some modeling algorithms may inherently weight observations differently. For example, in the regression context, Weighted Least Squares will adjust observations weights to reduce the impact of highly influential observations.

In other cases, weights are applied not in the model building step but immediately prior when setting the likelihood of an observation to be selected for training the model. For example, undersampling, oversampling or other sampling techniques are typically used in attempts to improve the performance of a model in predicting a minority class²⁵ but can also be used as a means of changing the base rate associated with each class²⁶. Some algorithms use biased resampling techniques directly in their model building procedures²⁷. Similar in effect to over and under sampling the data, models may also handle weights according to the outcome class of the observation²⁸.

Notes on Cost Sensitive Classification

Depending on your problem you might also use different approaches for weighting confusion matrices after model building. To account for differences in the value of classification outcomes you might weight items in the confusion matrix more heavily depending on what their actual condition is (e.g. TRUE outcomes are weighted higher than FALSE outcomes). You might also use a cost based approach to evaluate performance, whereby the diagonal elements on the confusion matrix (the correctly predicted items) have a cost of zero and all other cells are weighted according to their associated costs (see Questions on Cost Sensitive Classification for further discussion on these).

Some notes on implementations:

• The mlr package provides a helpful vignette (Cost-Sensitive Classification) that covers a variety of these and other approaches²⁹.
• In python the costcla module provides documentation on how to approach many of these types of problems in python.
• Unfortunately, the tidymodels suite of packages does not yet have broad support for weights. There are some relevant open issues, e.g. #3 in yardstick describes approaches for cost sensitive metrics.

Weighted Classification Metrics

I posted a question to Cross Validated (CV) on Weighting common performance metrics by classification outcomes?. I also reached out to other analytics professionals relating my questions about these metrics. I ultimately came to the conclusion that many performance metrics weighted by classification outcomes are inappropriate (other than expected value) or not useful so kept the focus of this post on using weighted classification outcomes strictly for maximizing expected value and identifying ideal cut-points on an already selected model.

I also changed my weighting scheme though not such that any cells in the confusion matrix would be zeroed out³⁰.

Weighted performance metrics on a confusion matrix at threshold of 0.5:

summary(conf_mat_0.5_weighted) %>% 
  knitr::kable(digits = 3)

Weighted performance metrics across decision thresholds:

conf_mats_df %>%
  mutate(across(contains("conf"), list(metrics = ~map(.x, summary)))) %>% 
  unnest(conf_mat_weighted_metrics) %>%
  select(-contains("conf"), -.estimator) %>% 
  filter(.metric != "sens") %>% 
  ggplot(aes(x = threshold, y = .estimate))+
  geom_line()+
  facet_wrap(~.metric, scales = "free_y")+
  labs(title = "Weighted Performance Metrics")

Interpretation of these metrics is unclear (as described on the CV issue mentioned above).

Questions on Cost Sensitive Classification

I was unsure on which type of weighting scheme I wanted to use for this post. This section walks through some of the questions I asked myself related to this.

Resources on cost based approaches to model evaluation of classification problems seemed to take a variety of different approaches. This left me with a few questions about what is appropriate and what is inappropriate.

Should the diagonal elements be zero?

Most of the examples I saw on cost-sensitive classification had their correctly predicted items (the diagonal of the confusion matrix) set to zero (assuming no or small costs associated with correctly predicted outcomes)³¹. There are some exceptions to this:

• Sowmya Vivek provides an example of this in her article Model performance & cost functions for classification models.
• Robert Moser’s post on Fraud detection with cost sensitive machine learning

These gave me some confidence that there isn’t a problem with having non-zero items on the diagonals.

Should off-diagonal elements be negated?

I did notice that Moser only used positive weighting whereas Vivek’s post had the weights sign negated depending on if it was on the diagonal or off-diagonal. I prefer Moser’s approach as I figure the signs could be negated when evaluating ‘value’ (which is the approach that I took³²).

Do weighted classification metrics make sense?

When weighting a confusion matrix, does it also make sense to calculate other weighted metrics, e.g. weighted precision, recall, etc.? Does it make sense to look at these across decision thresholds³³? The problem with the weighted versions of these metrics is that the possible number of observations could essentially change between decision cut-points because of observations slipping between higher or lower weighted classification outcomes. Does this present a mathematical challenge of some sort? Clearly if some cells are weighted to 0, some performance metrics may not make sense to calculate³⁴.

I ended-up posting this question on cross validated: Weighting common performance metrics by classification outcomes?.

Arriving at Weights

I initially used a different set of weights:

\[ Weights = \left(\begin{array}{cc} 0.14 & 1.89\\1.86 & 0.11 \end{array}\right)\]

I think this approach was an example of thinking too hard and that the approach here is incorrect or at least unnecessary… I also ended-up using a different set of weights (that were just made-up).

Say there are three things that determine how value should be weighted across a confusion matrix:

• How value is spread across the actual dimension
• How value is spread across the predicted dimension
• How value is shared between the actual and predicted dimensions

Say for example:

• value associated with an actual outcome of FALSE is 20 times as much as an actual outcome of TRUE (e.g. in the former case you may lose the entire loan amount, whereas in the latter case you only gain the interest payments). Converted to be in terms of proportion allocated to each item, we’d get \(A_t = \frac{1}{21}\) and \(A_f = \frac{20}{21}\)
• value associated with a prediction of TRUE is two times as much as a prediction of FALSE (e.g. higher administrative costs in the former case that go with administering the loan). Or \(P_t = \frac{2}{3}\) and \(P_f = \frac{1}{3}\)
• Say the value associated with the actual outcome is thirty times that of the value associated with the prediction. \(V_a = \frac{30}{31}\) and \(V_p = \frac{1}{31}\)

(Pretend also that we want all weights to sum to be equal to the number of cells in our confusion matrix.)

Assuming there is a multiplicative relationship between these outcomes. Calculating the value of the confusion matrix may become a matter of plugging in the associated values:

\[ Weights = 2\left(\begin{array}{cc} (A_tV_a+P_tV_p) & (A_fV_a+P_tV_p)\\(A_tV_a+P_fV_p) & (A_fV_a+P_fV_p) \end{array}\right)\]

This approach could be generalized for cases with more than two categories.