1 fairmodels

In this tutorial you will get to know when, why and how to use fairmodels. fairmodels is a tool for bias testing and fairness metrics visualization. It is compatible with DALEX and DALEXtra which are model agnostic explainers. Some knowledge of how to use those explainers will be needed but in this tutorial you should grasp the idea.

For this tutorial we will use compas data to see if someone will become recidivist in next 2 years.

1.1 Why?

Let’s say you are building court system that predicts if someone will become recidivist in the future. First you gather information then you build a model and predict outcomes. You get accuracy score of 90%. It is pretty good, but it appears that the model is more likely to say that African Americans will become recidivists. Model was trained on data that was discriminating certain ethnic groups. So now we have some options. First one is to change the data, and the second one is to tune model, and check if it behaves as we would like it to be. We will choose the second option.

1.2 Data

We will use modified ProPublica’s compas data to represent our problem.

library(fairmodels)
data("compas")

head(compas)

For fairmodels package to work properly we want to flip factor levels in target variable, so positive outcome (not being a recidivist) is being predicted by models. It is only needed for one specific function but more on it later.

compas$Two_yr_Recidivism <- as.factor(ifelse(compas$Two_yr_Recidivism == '1', '0', '1'))

1.3 Basic features

We train a ranger model and create an explainer with DALEX.

library(DALEX)
library(ranger)

# train
rf_compas <- ranger(Two_yr_Recidivism ~., data = compas, probability = TRUE)

# numeric target values
y_numeric <- as.numeric(compas$Two_yr_Recidivism)-1

# explainer
rf_explainer <- explain(rf_compas, data = compas[,-1], y = y_numeric, colorize = FALSE)

#> Preparation of a new explainer is initiated
#>   -> model label       :  ranger  (  default  )
#>   -> data              :  6172  rows  6  cols 
#>   -> target variable   :  6172  values 
#>   -> predict function  :  yhat.ranger  will be used (  default  )
#>   -> predicted values  :  numerical, min =  0.1590342 , mean =  0.5449543 , max =  0.8705104  
#>   -> model_info        :  package ranger , ver. 0.12.1 , task classification (  default  ) 
#>   -> residual function :  difference between y and yhat (  default  )
#>   -> residuals         :  numerical, min =  -0.8505374 , mean =  -7.418443e-05 , max =  0.7780252  
#>   A new explainer has been created!

1.3.1 fairness check

Than we create call function fairness_check() This function aggregates many explainers so you may compare many models. We assign object to name fobject which is short version of fairness_object - object returned by fairness_check(),

fobject <- fairness_check(rf_explainer,                         # explainer
                          protected = compas$Ethnicity,         # protected variable as factor
                          privileged = "Caucasian",             # level in protected variable, potentially more privileged
                          cutoff = 0.5,                         # cutoff - optional, default = 0.5
                          colorize = FALSE)

#> Creating fairness object
#> -> Privileged subgroup       : character ( Ok  )
#> -> Protected variable        : factor ( Ok  ) 
#> -> Cutoff values for explainers  : 0.5 ( for all subgroups )
#> -> Fairness objects      : 0 objects 
#> -> Checking explainers       : 1 in total (  compatible  )
#> -> Metric calculation        : 13/13 metrics calculated for all models
#>  Fairness object created succesfully

Let’s see if our ranger model has bias.

print(fobject, colorize = FALSE)

#> 
#> Fairness check for models: ranger 
#> 
#> ranger passes 0/5 metrics
#> Total loss:  2.547455

plot(fobject)

Of course the protected parameter can be changed, for example to binary compas$Sex.

In many metrics ranger exceeds fairness threshold (which can be changed by epsilon parameter). If bars reach red field on the left it means that there is bias towards certain unprivileged subgroup. If they reach one on the right it means bias towards privileged (Caucasian - in all metrics here Caucasian subgroup is referenced as base - 0) subgroup. Someone can argue that some groups are statistically more likely commit a crime but fairness_check() takes it into account. Statistical parity loss checks if proportion of assigned positive class is equal among all subgroups. In this example Native Americans and African Americans are more likely to be classified as recidivists. Other metrics measure how equal treatment and mistreatment among subgroups is. More on those metrics: wikipedia

Why do we have this bias? Model did learn from biased data. We can see it on plot below

1.3.2 plot density

plot_density(fobject)

As we can see it is more likely that model will categorize African Americans as not being recidivists than for example Asians. But maybe some groups are statistically more likely to go do crimes in the future. It is possible but that is why we used fairness_check() earlier. It does not only catch if subgroups are .

1.4 fairness object - idea

To really see what fairness_object is about, we need to make some more models and explainers.

library(gbm)

rf_compas_1 <- ranger(Two_yr_Recidivism ~Number_of_Priors+Age_Below_TwentyFive,
                      data = compas,
                      probability = TRUE)

lr_compas_1 <- glm(Two_yr_Recidivism~.,
                   data=compas,
                   family=binomial(link="logit"))

rf_compas_2 <- ranger(Two_yr_Recidivism ~., data = compas, probability = TRUE) 
rf_compas_3 <- ranger(Two_yr_Recidivism ~ Age_Above_FourtyFive+Misdemeanor,
                      data = compas,
                      probability = TRUE)

rf_compas_4 <- ranger(Two_yr_Recidivism ~.,
                      data = compas,
                      probability = TRUE)
df <- compas
df$Two_yr_Recidivism <- as.numeric(compas$Two_yr_Recidivism)-1
gbm_compas_1<- gbm(Two_yr_Recidivism~., data = df) 

explainer_1 <- explain(rf_compas_1,  data = compas[,-1], y = y_numeric)
explainer_2 <- explain(lr_compas_1,  data = compas[,-1], y = y_numeric)
explainer_3 <- explain(rf_compas_2,  data = compas[,-1], y = y_numeric, label = "ranger_2")
explainer_4 <- explain(rf_compas_3,  data = compas[,-1], y = y_numeric, label = "ranger_3")
explainer_5 <- explain(gbm_compas_1, data = compas[,-1], y = y_numeric)
explainer_6 <- explain(rf_compas_4,  data = compas[,-1], y = y_numeric, label = "ranger_4")

Now we create one object with all explainers

fobject <- fairness_check(explainer_1, explainer_2,
                            explainer_3, explainer_4,
                            explainer_5, explainer_6,
                            protected = compas$Ethnicity,
                            privileged = "Caucasian",
                            verbose = FALSE)

As we can see there is some parameters in fairness_check such as:
1. x, … - list of DALEX explainers, and other fairness_object objects
2. protected - factor, containing subgroups as levels. Protected stands for protected variable (or sensitive attribute)
3. privileged - character, level in protected, it is subgroup suspected of having better results
4. cutoff - numeric, vector of cutoffs values matching the order of levels in protected variable. It affects only explainers so if fairness_object is passed it’s cutoff vector won’t be changed.
5. label - character, vector of labels for explainers only. Very convenient for fairness_check() iterative approach - having explainer, checking for bias, mitigating bias, passing both explainer and fairness object and comparing fairness.
6. epsilon - numeric, boundary position in fairness_check(). Fairness metrics are satisfied if parity loss values are between (-epsilon, epsilon)

1.4.1 What consists of fairness object?

fairness_object is output value of fairness_check() It is S3 object consisting of: * Parity loss metrics Popular confusion matrix metrics with parity loss - sum of distances of metric values between unprivileged subgroups and privileged one. If model would have 0 in certain parity loss metric it would mean that it treats all subgroups equally.

fobject$parity_loss_metric_data

groups_data

Fairness object gets metrics based on confusion matrix and checks them over the groups.

# for the first model
fobject$groups_data$ranger$TPR

#> African_American            Asian        Caucasian         Hispanic 
#>        0.6697490        0.8695652        0.8149883        0.8406250 
#>  Native_American            Other 
#>        0.8333333        0.8858447

It is simply metrics for certain subgroup.

What is relation between $groups_data and $parity_loss_metric_data ?

If we were going only to take score from certain metric (Let’s say fpr and 0.3) we wouldn’t know if it is good or bad. But we are aiming for equal treatment over all groups so if this metric score would be the same in all groups it would be very good. But the metrics wouldn’t be comparable between each others (fpr - 0.3 in all groups and accuracy - 0.9 in all groups, both are good in terms of parity). That is why we use privileged - to set benchmark. And for example Caucasian in fpr had score of 0.3 and African American 0.6. After setting privilieged = Caucasian Caucasian would have score 0, and African American 0.3, because is the distance between those metrics.

Note: When dealing with aggregating plots we use formula sum(abs(1-score)) to represent aggregated score in metrics. In short is how much it differs from ideal scores.

explainers

list of DALEX explainers

cutoff

# for first model
fobject$cutoff$ranger

#> $African_American
#> [1] 0.5
#> 
#> $Asian
#> [1] 0.5
#> 
#> $Caucasian
#> [1] 0.5
#> 
#> $Hispanic
#> [1] 0.5
#> 
#> $Native_American
#> [1] 0.5
#> 
#> $Other
#> [1] 0.5

list of cutoff values for each model

fairness_check_data data used in print and plot of fairness_object. It is already processed data and ready to plot. If someone were to use abs() metrics there would be equal to particular metrics in $parity_loss_metric_data. It means that it allows negative values. So when value is negative it means that score of privileged group in this metric was better.
… - other parameters passed to fairness_check()

2 Choosing best model

We now have a few models in our fairness_object

Let’s see how they perform in different metrics.

2.1 Stacked Barplot

sm <- stack_metrics(fobject)
plot(sm)

It displays accumulated (Stacked) metric scores for each model. The least metric score the better.

2.2 Plot metric

cm <- choose_metric(fobject)
plot(cm)

2.3 Plot fairness PCA

With this task we should use PCA. We call create_fairness_pca() to create fairness pca object.

fair_pca <- fairness_pca(fobject)
print(fair_pca)

#> Fairness PCA : 
#>             PC1        PC2        PC3         PC4         PC5           PC6
#> [1,]  1.0204499 -0.4900304  1.1992329 -0.11005806  0.36993645 -2.081668e-17
#> [2,] -3.8304927 -1.0481108 -0.7564791 -0.03020753  0.12765587  9.367507e-17
#> [3,]  0.3968682  2.2419418 -0.3573946  0.62672941  0.05890035 -7.285839e-16
#> [4,]  2.7997319 -2.1269408 -0.7752283  0.14755832 -0.10667900 -2.775558e-16
#> [5,] -1.1886889 -0.2053592  1.1867171  0.07870345 -0.37551851  5.134781e-16
#> [6,]  0.8021317  1.6284995 -0.4968480 -0.71272558 -0.07429515  1.498801e-15
#> 
#> Created with: 
#> [1] "ranger"   "lm"       "ranger_2" "ranger_3" "gbm"      "ranger_4"
#> 
#> First two components explained 87 % of variance.

Let’s plot!

plot(fair_pca)

2.4 Plot Heatmap

Another way to deal with grouped data is using heatmap.

fheatmap <- fairness_heatmap(fobject)
plot(fheatmap, text_size = 3)

For both models and metrics dendograms are created. This way through hierarchical clustering we can look on similarities between models/metrics. It should give similar but more detailed information than PCA Now we know what those scores are and how “similar” models are to each other

2.5 Metric and Performance Plot

Sometimes we would like to know how good are models in performance metrics and in fairness metrics at the same time, to see the tradeoff between them.

fap <- performance_and_fairness(fobject, fairness_metric = "FPR")

#> Performace metric is NULL, setting deafult ( accuracy )  
#> 
#> Creating object with: 
#> Fairness metric: FPR 
#> Performance metric: accuracy

plot(fap)

2.6 Group Metric

When we have narrowed down our search for the best model we can use group_metric to check once again metrics within groups and decide which model to use.

fobject2 <- fairness_check(explainer_1,explainer_2, 
                                   protected = compas$Ethnicity,
                                   privileged = "Caucasian", 
                                    verbose = FALSE)


gm <- group_metric(fobject2, fairness_metric = "FPR")

#> Performace metric not given, setting deafult ( accuracy )  
#> 
#> Creating object with: 
#> Fairness metric:  FPR 
#> Performance metric:  accuracy

plot(gm)

2.7 Radar plot

fradar <- fairness_radar(fobject2)
plot(fradar)

2.8 Custom cutoff

We may see how cutoff affects parity loss of metrics

2.8.1 All cutoffs

All cutoffs measures where metrics exist (are not NA) and how they change if we modify cutoffs in all subgroups.

In this plot NA values are natural, so warnings are to be expected.

ac <- all_cutoffs(fobject2)

plot(ac)

2.8.2 Ceteris paribus cutoff

This function shows how parity loss metrics would change if we modified cutoff only for one subgroup (here African American) with other cutoffs fixed.

cpc <- ceteris_paribus_cutoff(fobject2, subgroup = "African_American")

plot(cpc)

3 Summary

fairmodels is powerful and flexible tool for detecting bias and asserting fairness in models. Many metrics are available (there are tools to create own metrics based on confusion matrix). Besides bias detection fairmodels offers also bias mitigation. It is set of pre-processing and post-processing algorithms working either on data or on explainer which function is to lower parity loss in certain metrics. If you are interested in this and adult data case study, please check Advanced Tutorial. If you encountered a bug or you have cool idea for a new feature please write and issue here.

Basic Tutorial

Jakub Wiśniewski