5  Classifier

Objectives

This chapter presents classifier (logistic regression) trained on the dataset presented in Chapter 4.

Display the setting codes 
# Required packages----
library(tidyverse)

# Graphs----
font_main = font_title = 'Times New Roman'
extrafont::loadfonts(quiet = T)
face_text='plain'
face_title='plain'
size_title = 14
size_text = 11
legend_size = 11

global_theme <- function() {
  theme_minimal() %+replace%
    theme(
      text = element_text(family = font_main, size = size_text, face = face_text),
      legend.text = element_text(family = font_main, size = legend_size),
      axis.text = element_text(size = size_text, face = face_text), 
      plot.title = element_text(
        family = font_title, 
        size = size_title, 
        hjust = 0.5
      ),
      plot.subtitle = element_text(hjust = 0.5)
    )
}

# Seed
set.seed(2025)

source("../functions/utils.R")

Following Kusner et al. (2017), a logistic regression model is trained. To convert (Y) into a categorical variable, the median is used as a threshold, in line with Black, Yeom, and Fredrikson (2020). The race, denoted as the sensitive attribute (S), has two categories: White and Black. The dataset is divided into training and testing sets. The classifier is first trained and used to compute the necessary quantities for counterfactual inference on the training set. Subsequently, the trained classifier is applied to the test set to make predictions and perform counterfactual analyses. The results of the counterfactuals will also be evaluated on the training set due to the limitation that Optimal Transport in the multivariate case cannot be computed for new samples, unlike the methodologies used in FairAdapt (Plečko, Bennett, and Meinshausen (2021)) and the approach developed in this paper.

5.1 Load Data

We load the data obtained in Chapter 4.3:

load("../data/df_race.rda")

5.2 Pre-processing

First, we transform \(Y\) into a binary variable:

med <- median(df_race$Y)
df_race_c <- df_race |> 
  mutate(
    Y_c = ifelse(Y > med, 1, 0)
  ) |> 
  select(S, X1, X2, Y = Y_c)

We turn the response variable to a factor:

df_race_c$Y <- as.factor(df_race_c$Y)
levels(df_race_c$Y)
[1] "0" "1"

Let us split the dataset into train/test sets (we use the split_dataset() function defined in functions/utils.R):

seed <- 2025
sets <- split_dataset(df_race_c, seed)
data_train <- sets$data_train
data_test <- sets$data_test

5.3 Training the Model

Then, we train two models:

  1. unaware logistic regression classifier: model without including the sensitive attribute.
  2. aware logistic regression classifier: model with the sensitive attribute included in the set of features.

The model is trained using the log_reg_train() function defined in functions/utils.R:

log_reg_train
function (train_data, test_data, type = c("aware", "unaware")) 
{
    if (type == "unaware") {
        train_data_ <- train_data %>% select(-S)
        test_data_ <- test_data %>% select(-S)
    }
    else {
        train_data_ <- train_data
        test_data_ <- test_data
    }
    model <- glm(Y ~ ., data = train_data_, family = binomial)
    pred_train <- predict(model, newdata = train_data_, type = "response")
    pred_test <- predict(model, newdata = test_data_, type = "response")
    list(model = model, pred_train = pred_train, pred_test = pred_test)
}

Let us train the two models. Then, we extract the predicted values on both the train set and the test set.

# Unaware logistic regression classifier (model without S)
pred_unaware <- log_reg_train(data_train, data_test, type = "unaware")
pred_unaware_train <- pred_unaware$pred_train
pred_unaware_test <- pred_unaware$pred_test

# Aware logistic regression classifier (model with S)
pred_aware <- log_reg_train(data_train, data_test, type = "aware")
pred_aware_train <- pred_aware$pred_train
pred_aware_test <- pred_aware$pred_test

We create a table for each model, with the sensitive attribute and the predicted value by the model (()), only for observations from the test set.

df_test_unaware <- tibble(
  S = data_test$S, 
  pred = pred_unaware_test
)

df_test_aware <- tibble(
  S = data_test$S, 
  pred = pred_aware_test
)
ggplot(
  data = df_test_unaware, 
  mapping = aes(x = pred, fill = S)) +
  geom_histogram(
    mapping = aes(y = after_stat(density)), 
    alpha = 0.5, position = "identity", binwidth = 0.05
  ) +
  geom_density(alpha = 0.5) +
  labs(
    title = "Unaware Model, with S being Race",
    x = "Predictions for Y",
    y = "Density"
  ) +
  global_theme()
Figure 5.1: Density of predictions on the test set, for the unaware model, when the sensitive attribute is the race 
ggplot(
  data = df_test_aware,
  mapping = aes(x = pred, fill = S)) +
  geom_histogram(
    mapping = aes(y = after_stat(density)), 
    alpha = 0.5, position = "identity", binwidth = 0.05
  ) +
  geom_density(alpha = 0.5) +
  labs(
    title = "Aware Model, with S being Race",
    x = "Predictions for Y",
    y = "Density"
  ) +
  global_theme()
Figure 5.2: Density of predictions on the test set, for the aware model, when the sensitive attribute is the race

5.4 Predictions

We predict values with the unaware model on the factuals:

model_unaware <- pred_unaware$model
pred_unaware_all <- predict(
  model_unaware, 
  newdata = df_race_c |> select(S, X1, X2), 
  type = "response"
)

And with the aware model:

model_aware <- pred_aware$model
pred_aware_all <- predict(
  model_aware, 
  newdata = df_race_c |> select(S, X1, X2), 
  type = "response"
)

5.5 Saving Objects

save(df_race_c, file = "../data/df_race_c.rda")
save(pred_aware, file = "../data/pred_aware.rda")
save(pred_unaware, file = "../data/pred_unaware.rda")
save(pred_unaware_all, file = "../data/pred_unaware_all.rda")
save(pred_aware_all, file = "../data/pred_aware_all.rda")