---
title:
  plain: "fairadapt: Causal Reasoning for Fair Data Pre-processing"
  formatted: "\\pkg{fairadapt}: Causal Reasoning for Fair Data Pre-processing"
  short: "\\pkg{fairadapt}: Fair Data Adaptation"
author:
  - name: Drago Plečko
    affiliation: ETH Zürich
    address: >
      Seminar for Statistics
      Rämistrasse 101
      CH-8092 Zurich
    email: \email{drago.plecko@stat.math.ethz.ch}
  - name: Nicolas Bennett
    affiliation: ETH Zürich
    address: >
      Seminar for Statistics
      Rämistrasse 101
      CH-8092 Zurich
    email: \email{nicolas.bennett@stat.math.ethz.ch}
  - name: Nicolai Meinshausen
    affiliation: ETH Zürich
    address: >
      Seminar for Statistics
      Rämistrasse 101
      CH-8092 Zurich
    email: \email{meinshausen@stat.math.ethz.ch}
abstract: >
  Machine learning algorithms are useful for various predictions tasks, but they can also learn how to discriminate, based on gender, race or other sensitive attributes. This realization gave rise to the field of fair machine learning, which aims to recognize, quantify and ultimately mitigate such algorithmic bias. This manuscript describes the \proglang{R}-package \pkg{fairadapt}, which implements a causal inference pre-processing method. By making use of a causal graphical model alongside the observed data, the method can be used to address hypothetical questions of the form "What would my salary have been, had I been of a different gender/race?". Such individual level counterfactual reasoning can help eliminate discrimination and help justify fair decisions. We also discuss appropriate relaxations which assume that certain causal pathways from the sensitive attribute to the outcome are not discriminatory.
keywords:
  formatted: [algorithmic fairness, causal inference, machine learning]
  plain: [algorithmic fairness, causal inference, machine learning]
preamble: >
  \usepackage{amsmath}
  \usepackage[ruled]{algorithm2e}
  \usepackage{bbm}
  \usepackage{array}
  \usepackage{pifont}
  \usepackage{booktabs}
  \usepackage{makecell}
  \newtheorem{definition}{Definition}
  \newcommand{\pa}{\mathrm{pa}}
  \newcommand{\Pa}{\mathrm{Pa}}
  \newcommand{\de}{\mathrm{de}}
  \newcommand{\ch}{\mathrm{ch}}
  \newcommand{\an}{\mathrm{an}}
  \newcommand{\pr}{\mathbbm{P}}
  \newcommand{\ex}{\mathbbm{E}}
  \renewcommand{\tilde}[1]{ {#1}^{(fp)}}
  \def\ci{{\perp\!\!\!\perp}}
vignette: >
  %\VignetteIndexEntry{fairadapt: Causal Reasoning for Fair Data Pre-processing}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
output: >
  if (packageVersion("rticles") < 0.5 || rmarkdown::pandoc_version() >= 2)
    rticles::jss_article else rmarkdown::html_vignette
documentclass: jss
classoption: nojss
bibliography: jss.bib
pkgdown:
  as_is: true
  extension: pdf
---

```{r, setup, include = FALSE}
knitr::opts_chunk$set(echo = TRUE)

library(fairadapt)
library(ggplot2)
library(ggraph)
library(ranger)
library(microbenchmark)
library(xtable)

options(
  prompt = "R> ",
  continue = "+ ",
  width = 70,
  useFancyQuotes = FALSE,
  tinytex.verbose = TRUE,
  kableExtra.latex.load_packages = FALSE
)

quick_build <- !identical(Sys.getenv("NOT_CRAN"), "true") ||
  isTRUE(as.logical(Sys.getenv("CI"))) ||
  !identical(Sys.getenv("FAIRADAPT_VIGNETTE_QUICK_BUILD"), "false")

is_on_cran <- !identical(Sys.getenv("NOT_CRAN"), "true")
run_sim <- FALSE
```

```{tikz, setup-graph, eval = FALSE, echo = FALSE}
\tikzset{
  >=stealth,
  rv/.style = {circle, draw, thick, minimum size = 6mm},
  rvc/.style = {triangle, draw, thick, minimum size = 10mm},
  node distance = 18mm
}
\newcommand{\myx}{2.5}
\definecolor{colone}{RGB}{164,202,202}
\definecolor{coltwo}{RGB}{215, 212,193}
\definecolor{colthree}{RGB}{187,180,160}
\usetikzlibrary{
  positioning, shadows, arrows, shapes, shapes.arrows, shapes.geometric,
  arrows.meta, trees, shapes.misc
}

\tikzset{
  every node/.style = {
    draw = none, align = center, fill = none, text centered,
    anchor = center
  },
  every label/.style={circle, draw, fill = yellow},
  f1/.style = {
    draw = , fill = gray!15, thick, inner sep = 3pt, minimum width = 7em,
    minimum height = 2em, align = center, text centered},
  f2/.style = {
    draw = none, fill = red!15, thick, inner sep = 3pt, minimum width = 5em,
    align = center, text centered
  },
  s1/.style = {
    fill = gray!10, thick, inner sep = 3pt, minimum width = 5em,
    minimum height = 1.5em, align = center, text centered}
}
```

# Introduction

As society transitions to an economy driven by artificial intelligence (AI), an increasing number of prediction tasks is delegated to AI tools. Sometimes these tasks are within socially sensitive domains, such as determining credit-score ratings or predicting recidivism during parole. In the process, it has been recognized that machine learning algorithms are capable of learning societal biases, which we might not want them to learn, for example with respect to race \citep{larson2016recidivism} or gender \citep{lambrecht2019algorithmic, blau2003pay}. This realization seeded an important debate in the machine learning community about fairness of algorithms and their impact on decision-making.

## Definitions of fairness

The first step towards understanding algorithmic fairness is about providing a formal definition of what fairness (or discrimination) means.
In light of this, existing intuitive notions have been mathematically formalized, thereby also providing fairness metrics that can be used to quantify discrimination. However, various different notions of fairness exist, and these are sometimes mutually incompatible \citep{corbett2018measure}, meaning they cannot be satisfied at the same time for a given predictor $\widehat{Y}$. In fact, there is currently no consensus on which notion of fairness is the correct one. Among the many proposal discussed in the literature, the most commonly considered ones include:

(1) *Demographic parity* \citep{darlington1971fairness}, which requires the protected attribute $A$ (gender, race, religion etc.) to be independent of a constructed classifier or regressor $\widehat{Y}$, written as
  $$\widehat{Y} \ci A.$$
(1) *Equality of odds* \citep{hardt2016eosl}, which requires equal false positive and false negative rates of classifier $\widehat{Y}$ between different groups (females and males for example) written as
  $$\widehat{Y} \ci A \mid Y.$$
(1) *Calibration* \citep{chouldechova2017fair}, which requires the protected attribute to be independent of the actual outcome given the prediction
  $$Y \ci A \mid \widehat{Y}.$$
Intuitively, this means that the protected attribute $A$ does not offer additional information about the outcome $Y$ once we know what the prediction $\widehat{Y}$ is.

## Fairness tasks

Apart from choosing a notion of fairness most appropriate to the setting that is analyzed, it is instructive to distinguish between two somewhat different tasks in fairness analysis. The first, usually simpler task is that of *bias quantification*, or bias measurement. In this case, we are interested in computing metrics from our dataset, in order to verify whether a definition is satisfied or not. Concretely, suppose we have a dataset in which $\widehat{Y}$ is the predicted salary of an employee and $A$ is sex. If we are interested in demographic parity, $\widehat{Y} \ci A$, we can compute the average difference in salary between the male/female groups, that is $$\ex[\widehat{Y} \mid A = \text{male}] - \ex[\widehat{Y} \mid A = \text{female}].$$ Based on this quantity (which is known as total variation, or TV for short), we might decide that either there is a disparity between sexes, or perhaps not. For other definitions of fairness, different metrics would be appropriate.

Sometimes performing the first step of bias measurement is not the end goal. Suppose that we found a large salary gap between sexes in the example above, raising issues about possible discrimination. We then might be interested in correcting this bias, by computing new, more fair predictions (in which, say, the salary gap is lower). This second task is that of *bias removal*, or bias mitigation, in which we want to remove the undesired bias from our predictions.

Different software tools can be used to perform the two fairness tasks described above. In Figure \ref{fig:software} we provide a graphical overview of some of the available software in \proglang{python} and \proglang{R}, which are the languages most commonly used for fairness analysis. For a given task and outcome/definition of fairness, we show the existing software packages that the reader might want to use. Since calibration is often satisfied by fitting an unconstrained model, our focus is on demographic parity and equality of odds.

```{tikz, software, fig.cap = "Software options for fair data analysis in \\proglang{R} and \\proglang{python}. In the left column, nodes correspond to \\proglang{R}-packages and in the right column to \\proglang{python} modules. DP stands for demographic parity, EO equality of odds.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "70%"}
<<setup-graph>>

\newcommand{\sx}{1.4}
\newcommand{\sy}{-1.4}
\usetikzlibrary{patterns.meta}

\begin{tikzpicture}

  \begin{scope}
		\draw [very thin] (\sx, -0.5 * \sy) -- (9 * \sx, -0.5 * \sy);
		\draw [very thin] (\sx, 0 * \sy) -- (9 * \sx, 0 * \sy);
		\draw [very thin] (\sx, 5.5 * \sy) -- (9 * \sx, 5.5 * \sy);
		\draw [very thin] (\sx, 6 * \sy) -- (9 * \sx, 6 * \sy);
		
	  \draw [very thin] (\sx, -0.5*\sy) -- (\sx, 6*\sy);
		\draw [very thin] (5*\sx, -0.5*\sy) -- (5*\sx, 6*\sy);
		\draw [very thin] (9*\sx, -0.5*\sy) -- (9*\sx, 6*\sy);
		
		\draw [thin, dotted] (3*\sx, 3.75*\sy) -- (3*\sx, 6*\sy);
    \draw [thin, dotted] (7*\sx, 3.75*\sy) -- (7*\sx, 6*\sy);
		\node (ce) at (2*\sx, 5.75*\sy) {Classification};
    \node (ce2) at (4*\sx, 5.75*\sy) {Regression};
    \node (ce3) at (6*\sx, 5.75*\sy) {Classification};
    \node (ce4) at (8*\sx, 5.75*\sy) {Regression};
		
    \draw [very thin] (\sx, 3.75*\sy) -- (9*\sx, 3.75*\sy);
    \draw [very thin] (\sx, 2 * \sy) -- (9 * \sx, 2*\sy);
		
    \draw [very thin] (1*\sx, 3.75*\sy) -- (0.5*\sx, 3.75*\sy);
    \draw [very thin] (1*\sx, 2*\sy) -- (0*\sx, 2*\sy);
    \draw [very thin] (1*\sx, 0*\sy) -- (0*\sx, 0*\sy);
    \draw [very thin] (1*\sx, 5.5*\sy) -- (0*\sx, 5.5*\sy);
		\draw [very thin] (0.5*\sx, 0*\sy) -- (0.5*\sx, 5.5*\sy);
    \draw [very thin] (0*\sx, 0*\sy) -- (0*\sx, 5.5*\sy);
		\node[rotate=90] () at (0.75*\sx, 2.875*\sy) {EO};
    \node[rotate=90] () at (0.75*\sx, 4.625*\sy) {DP};
    \node[rotate=90] () at (0.75*\sx, 1*\sy) {DP \& EO};
		\node [rotate=90] at (0.25*\sx, 1*\sy)  {Bias Detection};
  	\node [rotate=90] at (0.25*\sx, 3.75*\sy)  {Bias Removal};
        
    \node (r) at (3 * \sx, -0.25*\sy) {\textsf{R}};
    \node (pyhon) at (7 * \sx, -0.25*\sy) {\textsf{python}};
    

    \node [s1] () at (6*\sx, 0.5*\sy) {aif360};
    \node [s1] () at (6*\sx, 1*\sy) {fairlearn};
    \node [s1] () at (6*\sx, 1.5*\sy) {ethicML};
    \node [s1] () at (8*\sx, 1*\sy) {fairness\\indicators};
    

    \node [s1] () at (7*\sx, 2.375*\sy) {aif360};
    \node [s1] () at (7*\sx, 2.875*\sy) {fairlearn};
    \node [s1] () at (7*\sx, 3.375*\sy) {ethicML};

    
    \node [s1] () at (6*\sx, 4.125*\sy) {aif360};
    \node [s1] () at (6*\sx, 4.625*\sy) {fairlearn};
    \node [s1] () at (6*\sx, 5.125*\sy) {ethicML};
    \node [s1] () at (8*\sx, 4.125*\sy) {aif360};
    \node [s1] () at (8*\sx, 4.625*\sy) {fairlearn};
    \node [s1] () at (8*\sx, 5.125*\sy) {ethicML};
    
    \node [s1] () at (3*\sx, 2.875*\sy) {fairml};
    \node [s1] () at (3*\sx, 0.666*\sy) {fairness};
    \node [s1] () at (3*\sx, 1.333*\sy) {fairmodels};


    \node [s1] () at (2*\sx, 4.125*\sy) {fairmodels};
    \node [s1] () at (2*\sx, 4.625*\sy) {fairml};
    \node [s1] () at (2*\sx, 5.125*\sy) {fairadapt};
    
    \node [s1] () at (4*\sx, 4.125*\sy) {fairmodels};
    \node [s1] () at (4*\sx, 4.625*\sy) {fairml};
    \node [s1] () at (4*\sx, 5.125*\sy) {fairadapt};
      
  \end{scope}

\end{tikzpicture}
```

The software landscape for fair ML in \proglang{python} is more mature. Currently three well developed packages exist, capable of computing various fairness metrics. Also, these tools support training predictors that satisfy either equality of odds or demographic parity. These repositories are \pkg{aif360} \citep{aif360-oct-2018} maintained by IBM, \pkg{fairlearn} \citep{bird2020fairlearn} maintained by Microsoft and \pkg{EthicML} \citep{ethicMLrepo}. A further package, \pkg{fairness indicators} \citep{fairnessind}, is narrower in scope but suitable for computing fairness metrics on very large datasets.

For \proglang{R}, i.e., distributed via CRAN, there are fewer packages that relate to fair machine learning (see Figure \ref{fig:software}). Available packages include \pkg{fairml} \citep{scutari2021fairml}, which implements the non-convex method of \cite{komiyama2018nonconvex}, as well as \pkg{fairness} \citep{kozodoi2021fairness} and \pkg{fairmodels} \citep{wisniewski2021fairmodels}, which serve as diagnostic tools for measuring algorithmic bias and provide several pre- and post-processing methods for bias mitigation. The \pkg{fairadapt} package described in this manuscript is a bias removal method which is able to interpolate between demographic parity and calibration notions, and is applicable to both regression and classification settings. In particular, \pkg{fairadapt} is the only software in Figure \ref{fig:software} which is *causally aware*. This means that the bias removal performed by \pkg{fairadapt} can be explained by and related to the causal mechanisms that generated the discrimination in the first place.

## A causal approach

The discussion on algorithmic fairness is, however, not restricted to the machine learning domain. There are many legal and philosophical aspects that are paramount. For example, the legal distinction between the disparate impact and disparate treatment doctrines \citep{mcginley2011ricci, barocas2016big} is important for assessing fairness from a legal standpoint. This in turn emphasizes the importance of the interpretation behind the decision-making process, which is often not the case with black-box machine learning algorithms. For this reason, research in fairness through a causal inference lens gained attention.

A possible approach to fairness is the use of counterfactual reasoning \citep{galles1998axiomatic}, which allows for arguing what might have happened under different circumstances that never actually materialized, thereby providing a tool for understanding and quantifying discrimination. For example, one might ask how a change in sex would affect the probability of a specific candidate being accepted for a given job opening. This approach has motivated another notion of fairness, termed *counterfactual fairness* \citep{kusner2017counterfactual}, which states that the decision made, should remain fixed, even if, hypothetically, the protected attribute such as race or gender were to be changed (this can be written succinctly as $\widehat{Y}_i(a) = \widehat{Y}_i(a')$ in the potential outcomes notation). Causal inference can also be used for decomposing the total variation measure into its direct, mediated, and confounded contributions \citep{zhang2018fairness}, yielding further insights into demographic parity as a criterion. Furthermore, by introducing the notion of so-called resolving variables, \cite{kilbertus2017avoiding} described relaxations of demographic parity, which can possibly be a prohibitively strong notion.

The following sections describe an implementation of the fair data adaptation method outlined in \cite{plecko2020fair}, which combines the notions of counterfactual fairness and resolving variables, and explicitly computes counterfactual instances for individuals. The implementation is available as the \proglang{R}-package \pkg{fairadapt} from CRAN.

## Novelty in the package

A first version of \pkg{fairadapt} was published with the original manuscript \citep{plecko2020fair}. The software has since been developed further and novelty in the package presented in this manuscript includes the following:

* The methodology has been extended from the Markovian to the Semi-Markovian case (allowing noise variables to be correlated), which generalizes the scope of applications.
* Backdoor paths into the protected attribute $A$ are now allowed, meaning that the attribute $A$ does not need to be a root node of the causal graph.
* The user is provided with functionality for uncertainty quantification of the estimates.
* Introduction of S3 classes `fairadapt` and `fairadaptBoot`, alongside associated methods, provides a more formalized implementation.
* More flexibility is allowed in the quantile learning step, including different algorithms for quantile regression (linear, forest based, neural networks). Additionally, there is also a possibility of specifying a custom quantile learning function (utilizing S3 dispatch).
* The user is provided with functionality for assessing the quality of the quantile regression fit, which allows for tuning the hyperparameters of the more flexible algorithms.

The rest of the manuscript is organized as follows. In Section \ref{methodology} we describe the methodology behind \pkg{fairadapt}, together with reviewing some important concepts of causal inference. In Section \ref{implementation} we discuss implementation details and provide some general user guidance, followed by Section \ref{sec:uncq} in which we discuss how to perform uncertainty quantification with \pkg{fairadapt}. Section \ref{illustration} illustrates the use of \pkg{fairadapt} through a large, real-world dataset and a hypothetical fairness application. Finally, in Section \ref{sec:extensions} we elaborate on some extensions, such as Semi-Markovian models and resolving variables.

# Methodology

In this section, the intuition behind \pkg{fairadapt} is described using an example. This is followed by a more rigorous mathematical formulation, based on Markovian structural causal models (SCMs). Some relevant extensions, such as the Semi-Markovian case and the introduction of *resolving variables* are discussed in Section \ref{sec:extensions}.

## University admission example

Consider for example a dataset about students applying for university admission. Let variable $A$, gender, be the protected attribute ($A = a$ corresponding to females and $A = a'$ to males). Let $E$ denote educational achievement (measured for example by grades achieved in school) and $T$ the result of an admissions test for further education. Finally, let $Y$ be the outcome of interest (final score) upon which admission to further education is decided. A visual representation of how the variables affect each other is given in Figure \ref{fig:uni-adm}.

```{tikz, uni-adm, fig.cap = "A visual representation of the university admission example. $A$ denotes gender, $E$ previous educational achievement, and $T$ an admissions test score. The outcome $Y$ represents the final score used for the admission decision. The protected attribute $A$ has a discriminatory causal effect on variables $E$, $T$, and $Y$, which we wish to remove.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "50%"}

<<setup-graph>>

\begin{tikzpicture}

  \pgfsetarrows{latex-latex};

  \begin{scope}
    \node[rv] (1) at (-2,0) {$A$};
    \node[rv] (2) at (0,0) {$E$};
    \node[rv] (3) at (2,0) {$T$};
    \node[rv] (4) at (4,0) {$Y$};
    \draw[->] (1) -- (2);
    \draw[->] (1) edge[bend left = 20] (3);
    \draw[->] (2) -- (3);
    \draw[->] (2) -- (3);
    \draw[->] (3) -- (4);
    \draw[->] (2) edge[bend right = 25] (4);
  \end{scope}

\end{tikzpicture}
```

Attribute $A$, gender, has a causal effect on variables $E$, $T$, and $Y$. We consider this effect discriminatory and wish to eliminate it, in the following way. For each individual with observed values $(a, e, t, y)$ we want to find a mapping

$$(a, e, t, y) \longrightarrow  (\tilde{a}, \tilde{e}, \tilde{t}, \tilde{y}),$$

which represents the value the person would have obtained in an alternative world where everyone was female. To construct such a mapping, we adapt (transform) the variables in the dataset in order. Explicitly, to a male person with education value $e$, we assign the transformed value $\tilde{e}$, chosen such that

$$\pr(E \geq e \mid A = a') = \pr(E \geq \tilde{e} \mid A = a).$$

The key idea is that the *relative educational achievement within the subgroup* remains preserved if the protected attribute gender is changed. If, for example, a male person has a higher educational achievement value than 70\% of males in the dataset, we assume that he would also be better than 70\% of females, had he been female^[This assumption of course is not empirically testable, as it is impossible to observe both a female and a male version of the same individual.]. After computing transformed educational achievement values corresponding to the *female* world ($\tilde{E}$), the transformed test score values $\tilde{T}$ can be calculated in a similar fashion, but conditional on educational achievement. That is, a male with values $(E, T) = (e, t)$ is assigned a test score $\tilde{t}$ such that

$$\pr(T \geq t \mid E = e, A = a') = \pr(T \geq \tilde{t} \mid E = \tilde{e}, A = a),$$

where the value $\tilde{e}$ was obtained in the previous step. This step can be visualized as shown in Figure \ref{fig:quantmap}.

```{tikz, rel-edu, fig.cap = "\\label{fig:quantmap}A graphical visualization of the quantile matching procedure. Given a male with a test score corresponding to the 70\\% quantile, we would hypothesize, that if the gender was changed, the individual would have achieved a test score corresponding to the 70\\% quantile of the female distribution.", fig.ext = "png", cache = TRUE, echo = FALSE, eval = !is_on_cran, engine.opts=list(extra.preamble = c("\\usepackage{bbm}", "\\usepackage{pgfplots}", "\\pgfplotsset{compat=newest}"))}

\newcommand{\pr}{\mathbbm{P}}
\renewcommand{\tilde}[1]{ {#1}^{(fp)}}

\usetikzlibrary{arrows.meta}

\pgfmathdeclarefunction{gauss}{2}{\pgfmathparse{1/(#2*sqrt(2*pi))*exp(-((x-#1)^2)/(2*#2^2))}}

\begin{tikzpicture}

  \begin{axis}[
    no markers, domain=0:10, samples=100,
    axis lines = left,
    xlabel = $t$,
    ylabel = $\pr(t)$,
    every axis y label/.style={at=(current axis.above origin),anchor=south},
    every axis x label/.style={at=(current axis.right of origin),anchor=west},
    height=5cm, width=12cm,
    xtick=\empty, ytick=\empty,
    enlargelimits=false, clip=false, axis on top,
    grid = major
  ]

    \addplot [very thick,green!50!black] {gauss(4,1)};
    \addplot [very thick,blue!50!black] {gauss(6.5,0.8)};

    \draw[-{Latex[length=3mm,width=2mm]}, dashed] (axis cs:2.718,0.175) to[bend right = 30] (axis cs:5.474,0.219);
    \draw[-{Latex[length=3mm,width=2mm]}, dashed] (axis cs:4.524, 0.348) to[bend right = 30] (axis cs:6.920, 0.435);

    \node at (axis cs:2.718,0.175) [above, left]
      {\shortstack{$10\%$-quantile \\ (Male)}};
    \node at (axis cs:5.474,0.219) [below = 0.3cm, right = 0cm]
      {\shortstack{$10\%$-quantile \\ (Female)}};
    \node at (axis cs:4.524, 0.348) [above = 0.3cm]
      {\shortstack{$70\%$-quantile \\ (Male)}};
    \node at (axis cs:6.920, 0.435) [right]
      {\shortstack{$70\%$-quantile \\ (Female)}};
    \node at (axis cs:4,0.5) [below = 0.65cm, left = 0.5cm, green!50!black]
      {$T \mid E = e, A = a'$};
    \node at (axis cs:6.5,0.5) [below = 1.3cm, right = 1cm, blue!50!black]
      {$T \mid E = \tilde{e}, A = a$
    };

  \end{axis}

\end{tikzpicture}
```

In the final step, the outcome variable $Y$ needs to be adjusted. The adaptation is based on the same principle as above, using transformed values of both education and the test score. The transformed value $\tilde{y}$ of $Y = y$ is chosen to satisfy

$$\pr(Y \geq y \mid E = e, T = t, A = a') = \pr(Y \geq \tilde{y} \mid E = \tilde{e}, T = \tilde{t}, A = a).$$

The form of counterfactual correction described above is known as *recursive substitution* \citep[Chapter~7]{pearl2009causality}. We formalize this approach in the following sections. The reader who is satisfied with the intuitive notion provided by the above example is encouraged to go straight to Section \ref{implementation}.

## Structural causal models

In order to describe the causal mechanisms of a system, a *structural causal model* (SCM) can be hypothesized, which fully encodes the assumed data-generating process. An SCM is represented by a 4-tuple $\langle V, U, \mathcal{F}, \pr(u) \rangle$, where

* $V = \lbrace V_1, \ldots, V_n \rbrace$ is the set of observed (endogenous) variables.
* $U = \lbrace U_1, \ldots, U_n \rbrace$ are latent (exogenous) variables.
* $\mathcal{F} = \lbrace f_1, \ldots, f_n \rbrace$ is the set of functions determining $V$, $v_i \gets f_i(\pa(v_i), u_i)$, where $\pa(V_i) \subset V, U_i \subset U$ are the functional arguments of $f_i$ and $\pa(V_i)$ denotes the parent vertices of $V_i$.
* $\pr(u)$ is a distribution over the exogenous variables $U$.

Any particular SCM is accompanied by a graphical model $\mathcal{G}$ (a directed acyclic graph, DAG). The set of variables that are inputs of the mechanism $f_{V_i}$ are the parents of $V_i$ denoted by $\pa(V_i)$. Therefore, the graph encodes how variables affect one another. Furthermore, we also write $\ch(V_i), \de(V_i), \an(V_i)$ for the children, descendants, and ancestors of $V_i$ in the graph $\mathcal{G}$. We assume throughout, without loss of generality, that

(i) $f_i(\pa(v_i), u_i)$ is increasing in $u_i$ for every fixed $\pa(v_i)$.
(i) Exogenous variables $U_i$ are uniformly distributed on $[0, 1]$.

Equipped with the notion of an SCM and the assumptions (i)-(ii), we can describe the adaptation procedure in the Markovian case, in which all exogenous variables $U_i$ are mutually independent (for the Semi-Markovian case, where variables $U_i$ are allowed to share information, see Section \ref{sec:extensions}).

## Markovian SCM formulation

Let $Y$ be the outcome of interest, taking values in $\mathbbm{R}$. Let $A$ be the binary protected attribute taking two values $a, a'$. Denote by $X$ the remaining covariates, and let $V = (A, X, Y)$ denote the observed variables. Our goal is to describe a pre-processing method which transforms the observed variables $V$ into their fair version $\tilde{V}$. This is achieved by computing the counterfactual values $V(A = a)$, which would have been observed if the protected attribute was fixed to a baseline value $A = a$ for the entire sample.

More formally, going back to the *university admission* example above, we want to align the distributions

$$V_i \mid \pa(V_i), A = a \text{ and } V_i \mid \pa(V_i), A = a',$$
meaning that the distribution of $V_i$ conditional on $\pa(V_i)$ should be indistinguishable between female and male groups (and this should hold for every variable $V_i$). Since each function $f_i$ of the original SCM is reparametrized so that $f_i(\pa(v_i), u_i)$ is increasing in $u_i$ for every fixed $\pa(v_i)$, and since variables $U_i$ are uniformly distributed on $[0, 1]$, the $U_i$ values can be interpreted as the latent *quantiles* associated with $V_i$. These latent quantiles are assumed to be preserved when performing the adaptation procedure.

The fair data adaption algorithms starts by fixing $A = a$ for all individuals. After this, the algorithm iterates over descendants of the protected attribute $A$, in any valid topological order (this topological order is inferred from the causal graph $\mathcal{G}$, which is also an input of the algorithm). For each $V_i$, the assignment function $f_i$ and the corresponding quantiles $U_i$ are inferred. Finally, transformed values $\tilde{V_i}$ are obtained by evaluating $f_i$, using quantiles $U_i$ and the transformed parents $\tilde{\pa(V_i)}$ (see Algorithm \ref{algo:fairadapt}).

\begin{algorithm}
	\DontPrintSemicolon
	\KwIn{observed variables $V$, causal graph $\mathcal{G}$}
	set $A \gets a$ for everyone\\
	\For{$V_i \in \de(A)$ in topological order}{
	  learn function $V_i \gets f_i(\pa(V_i), U_i)$ \;
		infer quantiles $U_i$ associated with the variable $V_i$\;
		transform values as $\tilde{V_i} \gets f_i (\tilde{\pa(V_i)}, U_i)$
		 \;
  }
  \Return{$\tilde{V}$}
	\caption{Fair Data Adaptation}
	\label{algo:fairadapt}
\end{algorithm}

The assignment functions $f_i$ of the SCM are always assumed to be unknown, but are inferred non-parametrically at each step. Algorithm \ref{algo:fairadapt} obtains the counterfactual values $V(A = a)$ under the $do(A = a)$ intervention for each individual, while keeping the latent quantiles $U$ fixed. In the case of continuous variables, the latent quantiles $U$ can be determined exactly, while for the discrete case, the situation is more subtle. A detailed discussion can be found in \citet[Section~5]{plecko2020fair}.

# Implementation

The main function for data adaption in the \pkg{fairadapt} package is `fairadapt()`. This function returns an S3 classed object of class `fairadapt`. The `fairadapt` class has associated implementations of the base \proglang{R} S3 generics `print()`, `summary()`, `plot()` and `predict()`. Furthermore, methods are available for the `autoplot()` generic exported from \pkg{ggplot2} \citep{wickham2016ggplot2}, as well as `fairadapt`-specific implementations of S3 generics `visualizeGraph()`, `adaptedData()`, `quantFit()`, and `fairTwins()`.

The following sections describe the intended use of `fairadapt()`, together with the associated methods and their relations. The most important arguments of `fairadapt()` include:

* `formula`: Argument of type `formula`, specifying the dependent and explanatory variables.
* `adj.mat`: Argument of type `matrix`, encoding the adjacency matrix.
* `train.data` and `test.data`: Both of type `data.frame`, representing the respective datasets.
* `prot.attr`: Scalar-valued argument of type `character` identifying the protected attribute. Has to correspond to a column name in the `train.data` argument.

It is worth clarifying the possible data types that can be used in the `train.data` argument. We note the following:

(i) *Attribute $A$*: the protected attribute is assumed to be binary. The \code{prot.attr} column in \code{train.data} can be of any data type coercible to a \code{factor}, but can only take two distinct values. Otherwise an error is thrown.
(i) *Outcome $Y$*: the dependent variable specified on the left hand side of the \code{formula} argument can be either a \code{numeric}, \code{logical}, \code{integer} (treated the same as an ordered factor), \code{factor}, or a \code{character}\footnote{Care needs to be taken when supplying unordered \code{factor} or \code{character} inputs since the adaptation procedure depends on the order of the levels of the outcome variable. For such inputs, the order of the levels will be chosen automatically, so using an ordered \code{factor} for the outcome variable is the recommended option.}.
(i) *Remaining covariates $X$*: all other variables do not have limitations. Unordered \code{factor} or \code{character} inputs can also be used as covariates $X$.

As an example, we perform fair data adaption on the university admission dataset described in Section \ref{methodology}. We load the `uni_admission` dataset provided by \pkg{fairadapt} (inspired by the Berkeley admissions dataset \citep{bickel1975sex}), consisting of synthetic university admission data of `r nrow(uni_admission)` students. We subset the data, using the first `n_samp` rows as training data (`uni_trn`) and the following `n_samp` rows as testing data (`uni_tst`). Furthermore, we construct an adjacency matrix `uni_adj` with edges $\texttt{gender} \to \texttt{edu}$, $\texttt{gender} \to \texttt{test}$, $\texttt{edu} \to \texttt{test}$, $\texttt{edu} \to \texttt{score}$, and $\texttt{test} \to \texttt{score}$, corresponding to the causal graph from Figure \ref{fig:uni-adm}. We set `gender` as the protected attribute.

```{r, basic}
n_samp <- 500

uni_dat <- data("uni_admission", package = "fairadapt")
uni_dat <- uni_admission[seq_len(2 * n_samp), ]

head(uni_dat)

uni_trn <- head(uni_dat, n = n_samp)
uni_tst <- tail(uni_dat, n = n_samp)

uni_dim <- c(       "gender", "edu", "test", "score")
uni_adj <- matrix(c(       0,     1,      1,       0,
                            0,     0,      1,       1,
                            0,     0,      0,       1,
                            0,     0,      0,       0),
                  ncol = length(uni_dim),
                  dimnames = rep(list(uni_dim), 2),
                  byrow = TRUE)

set.seed(2022)
basic <- fairadapt(score ~ ., train.data = uni_trn,
                    test.data = uni_tst, adj.mat = uni_adj,
                    prot.attr = "gender")

basic
```

The implicitly called `print()` method in the previous code block displays some information about how `fairadapt()` was called. This information includes the variables that were adapted, the protected attribute, and the causal graph used for the adaptation (printed as an adjacency matrix). By additionally calling the `summary()` function, we can inspect the number of training an test samples, and the total variation before and after adaptation, written in our notation as

$$\ex [Y \mid A = a] - \ex [Y \mid A = a'] \text{ and } \ex [\tilde{Y} \mid A = a] - \ex [\tilde{Y} \mid A = a'],$$
respectively, shown below:

```{r fairadapt-summary}
summary(basic)
```

The adapted train and test data can be obtained using the `adaptedData()` function and passing the argument `train = TRUE` for the training data, and `train = FALSE` for the test data:

```{r adapted-data-example}
head(adaptedData(basic, train = FALSE))
```

## Specifying the graphical model

The algorithm used for fair data adaption in `fairadapt()` is based on graphical causal model $\mathcal{G}$ (see Algorithm \ref{algo:fairadapt}). To specify the causal graph, we pass the corresponding adjacency matrix as the `adj.mat` argument. The convenience function `graphModel()` turns a graph specified as an adjacency matrix into an annotated graph using the \pkg{igraph} package \citep{csardi2006igraph}. Alternatively, by calling the S3 generic `visualizeGraph()` on a `fairadapt` object, the user can also inspect the graphical model that was used for the data adaptation.

```{r, graph-model}
uni_graph <- graphModel(uni_adj)
```

```{r, graph-plot, echo = FALSE, fig.width = 6, fig.height = 3, fig.cap = "The underlying graphical model corresponding to the university admission example (also shown in Figure \\ref{fig:uni-adm}).", out.width = "60%"}

set.seed(11)

ggraph(graphModel(uni_adj), "igraph", algorithm = "sugiyama") +
  geom_edge_link(arrow = arrow(length = unit(4, "mm"), angle = 15,
                               type = "closed"),
                 end_cap = circle(8, "mm"),
                 color = "grey20") +
  geom_node_point(color = "grey80", size = 21) +
  geom_node_text(aes(x = x, y = y, label = name), size = 5) +
  theme_bw() +
  theme(plot.margin = margin(30, 30, 30, 30), panel.border = element_blank(),
        panel.background = element_blank(), axis.title = element_blank(),
        axis.text = element_blank(), axis.line = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank()) +
  coord_cartesian(clip = "off")
```

A visualization of the `igraph` object returned by `graphModel()` is shown in Figure \ref{fig:graph-plot}. The graph is the same as that in Figure \ref{fig:uni-adm}. However, specifying the causal graph is not the only option to perform the data adaptation. A possible alternative is to specify a valid topological ordering over the observable variables $V$, and specify it as a `character` vector, using the `top.ord` argument.

## Quantile learning step

The most common and recommended usage of `fairadapt()` follows a typical machine learning framework. We start by calling the `fairadapt()` function that performs the quantile learning step and counterfactual correction, based on the `train.data` argument. Following this, we can call the `predict()` function on the returned `fairadapt` S3 object, in order to perform data adaption on new test data. In such a workflow, the adaptation of the training and testing data is done separately.
In specific situations, it might be desirable to input both `train.data` and `test.data` arguments directly to `fairadapt()`, which then transforms both the training and testing data jointly. This one-step procedure might be considered when the proportion of test samples compared to train samples is large, and when the `train.data` has a relatively small sample size. The benefit of this approach is that, even though the outcome $Y$ is not available, other attributes $X$ of `test.data` can be used for quantile learning step.

The data frames passed as `train.data` and `test.data` are required to have column names which also appear in the row and column names of the adjacency matrix. The protected attribute $A$, passed as scalar-valued character vector `prot.attr`, should also appear in the column names of `train.data` and `test.data`. The `test.data` argument defaults to `NULL`, with the intention that `test.data` is specified as an input to the `predict()` function at a later stage.

### Quantile methods

The quantile learning step of Algorithm \ref{algo:fairadapt} can in principle be carried out by several methods, three of which are implemented in \pkg{fairadapt}:

* Quantile Regression Forests \citep{meinshausen2006qrf, wright2015ranger}.
* Non-Crossing Quantile Neural Networks \citep{cannon2018non, cannon2015package}.
* Linear Quantile Regression \citep{koenker2001qr, koenker2018package}.

Using linear quantile regression is the most efficient option in terms of runtime, while for non-parametric models and mixed data, the random forest approach is well-suited, at the expense of a slight increase in runtime. The neural network approach is substantially slower when compared to linear and random forest estimators and consequently does not scale well to large sample sizes. As default, the random forest based approach is used, due to its non-parametric nature and computational speed. However, for smaller sample sizes, the neural network approach can also demonstrate competitive performance. In Table \ref{tab:qmethods} we provide a quick summary outlining some differences between the three natively supported methods, and also report runtimes on the `uni_admission` dataset with different sample sizes.

```{r benchmark-quant-methods, echo = FALSE, results = "asis"}

linebreak <- function(..., align = c("l", "c", "r"), linebreaker = "\n") {

  x <- c(...)

  ifelse(
    grepl(linebreaker, x, fixed = TRUE),
    paste0("\\makecell[", match.arg(align), "]{",
           gsub(linebreaker, "\\\\", x, fixed = TRUE), "}"),
    x
  )
}

bm_cache <- system.file("extdata", "bm_quant.rds", package = "fairadapt")

if (!run_sim && file.exists(bm_cache)) {

  bmark <- readRDS(bm_cache)

} else {

  nsamps <- c(200L, 500L)

  bmark <- lapply(
    c(rangerQuants, mcqrnnQuants, linearQuants),
    function(quant.method) {
      lapply(
        nsamps, function(nsamp) {
          tim <- microbenchmark(
            fairadapt(score ~ ., train.data = uni_admission[seq_len(nsamp), ],
                      test.data = uni_admission[seq.int(nsamp + 1 , 2 * nsamp), ],
                      adj.mat = uni_adj, prot.attr = "gender",
                      quant.method = quant.method), times = 5L
          )$time
          round(mean(tim) / 10^9, digits = 1L)
        }
      )
    }
  )

  bmark <- do.call(cbind, bmark)

  colnames(bmark) <- c("Random forest", "Neural network", "Linear regression")
  rownames(bmark) <- as.character(nsamps)

  saveRDS(bmark, file.path("..", "inst", "extdata", "bm_quant.rds"))
}

rownames(bmark) <- paste0("$T_{\\text{uni}}(", rownames(bmark), ")$")

tbl <- data.frame(
  linebreak(
    "\\pkg{ranger}", "\\code{rangerQuants}", "$O(np\\log n)$",
    "$ntrees = 500$\n$mtry = \\sqrt{p}$"
  ),
  linebreak(
    "\\pkg{qrnn}", "\\code{mcqrnnQuants}", "$O(npn_{\\text{epochs}})$",
    "1 hidden layer\nfully connected\nfeed-forward\nnetwork"
  ),
  linebreak(
    "\\pkg{quantreg}", "\\code{linearQuants}", "$O(p^2n)$",
    "\\code{\"br\"} method of\nBarrodale and\nRoberts used for\nfitting"
  )
)

colnames(tbl) <- colnames(bmark)
rownames(tbl) <- linebreak(
  "\\proglang{R}-package", "\\texttt{quant.method}", "Complexity",
  "Default\nparameters"
)

tbl <- rbind(tbl, bmark)

capt <- paste(
  "Summary table of different quantile regression methods. $n$ is the number",
  "of samples, $p$ number of covariates, $n_{\\text{epochs}}$ number of",
  "training epochs for the neural network. $T_{\\text{uni}}(n)$ denotes the",
  "runtime of different methods on the university admission dataset, with $n$",
  "training and $n$ testing samples. The runtimes were obtained on a system", 
  "with Intel Core i7-8750H CPU @ 2.2GHz running MacOS Big Sur 11.6.",
  "The version of \\proglang{R} was 4.2.0 \"Vigorous Calisthenics\" with \\pkg{quantreg}", 
  "version 5.93, \\pkg{ranger} version 0.13.1, and \\pkg{mcqrnn} version 2.0.5."
)

print(
  xtable(tbl, caption = capt, label = "tab:qmethods",
         align = rep("l", ncol(tbl) + 1L)),
  booktabs = TRUE,
  table.placement = "t",
  sanitize.text.function = identity,
  comment = FALSE
)
```

### Influencing the fit

The quantile methods shown in Table \ref{tab:qmethods} make calls to specific functions that perform quantile regression. These functions take varying arguments and for that reason, `fairadapt()` forwards arguments passed as `...` to the function specified as `quant.method`.

#### Computational speed

An important consideration in choosing values for optional arguments of specific quantile regression functions is computational speed. For example, the function `rangerQuants()` internally calls the `ranger()` function (from \pkg{ranger}) and with respect to computational speed, an important argument is `num.trees`, the number of trees used when building the quantile regression forest. Clearly, choosing a smaller number of trees will be faster, but at the same time will result in a fit with larger variance.

Similarly, `mcqrnnQuants()` internally calls `mcqrnn.fit()` (from \pkg{qrnn}), which has a number of arguments that can be used for adapting the underlying neural network. In terms of computational speed, the most important arguments are `n.trials` (number of repeated initializations used to avoid local minima) and `iter.max` (maximum number of iterations of the optimization). Choosing smaller values will reduce the runtime. Lastly, function `linearQuants()` internally calls `rq()` (from \pkg{quantreg}). This function is less flexible, since the model is linear. However, its `method` argument can be used when the number of samples becomes large (using `method` equal to `"fn"` or `"pfn"` utilizes the Frisch-Newton interior point method, which may be preferable for large samples).

#### Fit quality

Both `rangerQuants()` and `mcqrnnQuants()` expose flexible machine learning tools with several parameters that impact fit quality. In order to optimize the fitting procedure by tuning these parameters, we need a way of assessing the quality of our fit. In the context of quantile regression we can estimate the expected $\tau$-quantile loss function,

\begin{equation}
\label{eq:quantloss}
\ex[\rho_{\tau}(V_i, \mu_{\tau}(\pa(V_i)))],
\end{equation}

where $\mu_{\tau}(\pa(V_i))$ is the function predicting the $\tau$-quantile of variable $V_i$ using the parents $\pa(V_i)$ and $\rho_{\tau}$ is the asymmetric L1 loss function whose minimizer is the $\tau$-quantile. The function $\rho_{\tau}$ is given by

$$
\rho_{\tau}(x, y) = \begin{cases}
                      \phantom{( )}\tau(x-y), & \text{ for } x \geq y\\
                      (1-\tau)(y-x), & \text{ for } x < y.
                    \end{cases}
$$

A smaller empirical loss based on Equation \ref{eq:quantloss} corresponds to better fit quality. For hyperparameter tuning we can perform cross-validation (fitting the quantile regression on separate folds), which is directly available within the `fairadapt()` function. The argument `eval.qfit` has a default value `NULL`, but if this argument is given a positive integer value, then it is used as the number of folds for performing cross-validation.

We compute the average empirical loss $\widehat{\ex} [\rho_{\tau} (V_i, \mu_{\tau}(\pa(V_i)))]$ for each variable $V_i$ and $\tau = 0.25, 0.5, 0.75$ (corresponding to 25\%, 50\% and 75\% quantiles). The average of these three values is reported at the end, and can be extracted from the resulting `fairadapt` object using the `quantFit()` method:

```{r, quantFit}
set.seed(22)
fit_qual <- fairadapt(score ~ ., train.data = uni_trn,
                      adj.mat = uni_adj, prot.attr = "gender",
                      eval.qfit = 3L)

quantFit(fit_qual)
```

The function returns the quality of the quantile fit for each variable. A very reasonable objective to minimize is the average of these values, by iterating over a grid of possible values of the tuning parameters. The interesting parameters to optimize for the two methods include:

(i) for `ranger()`: parameters `mtry` (number of candidate variables considered for splitting in each step), `min.node.size` (size of leaf nodes below which splitting is stopped) and `max.depth` (maximum depth of each tree),
(i) for `mcqrnn()`: parameters `n.hidden`, `n.hidden2` (number of nodes in the first and second hidden layers), `Th` (activation function), `method` (optimizer to be used), and a range of other parameters that are fed to the chosen optimizer via ellipsis.

The quantile methods included in \pkg{fairadapt} have reasonable default values, that serve as a good starting point. Optimizing the quantile fit should therefore be of interest mostly to advanced users (and hence we do not perform parameter tuning here explicitly).

### Extending to custom methods

The above-mentioned set of methods is not exhaustive. Further options are conceivable and therefore \pkg{fairadapt} provides an extension mechanism to allow for custom quantile method specified by the user. The `fairadapt()` argument `quant.method` expects a function to be passed, a call to which will be constructed with three unnamed arguments:

1. A `data.frame` containing data to be used for quantile regression. This will either be the `data.frame` passed as `train.data`, or if `test.data` was specified, a concatenated, row-bound version of `train.data` and `test.data`.
1. A logical flag, indicating whether the protected attribute is the root node of the causal graph. If the attribute $A$ is a root node, we know that $$\pr(X \mid \text{do}(A = a)) = \pr(X \mid A = a).$$ Therefore, the interventional and conditional distributions are in this case the same, and we can leverage this knowledge in the quantile learning procedure, by splitting the data into $A = 0$ and $A = 1$ groups.
1. A `logical` vector of length `nrow(data)`, indicating which rows in the `data.frame` passed as `data` correspond to samples with baseline values of the protected attribute.

Arguments passed as `...` to `fairadapt()` will be forwarded to the function specified as `quant.method` and passed after the first three fixed arguments listed above. The return value of the function passed as `quant.method` is expected to be an S3-classed object. This object should represent the conditional distribution $V_i \mid \pa(V_i)$ (see function `rangerQuants()` for an example). Additionally, the object should have an implementation of the S3 generic function `computeQuants()` available. For each row $(v_i, \pa(v_i))$ of the `data` argument, the `computeQuants()` function uses the S3 object to perform the following steps:

(i) Infer the quantile of $v_i \mid \pa(v_i)$.
(i) Compute the counterfactual value $\tilde{v}_i$ under the change of protected attribute, using the counterfactual values of parents $\pa(\tilde{v}_i)$ computed in previous steps (values $\pa(\tilde{v}_i)$ are contained in the `newdata` argument).

For an example, see the `computeQuants.ranger()` method for a `ranger` object, which can be invoked by the `computeQuants()` generic. 

## Fair-twin inspection

We now turn to a useful property of \pkg{fairadapt}, which allows the user to explore counterfactual instances for different individuals in the dataset. The university admission example presented in Section \ref{methodology} demonstrates how to compute counterfactual values for an individual while preserving their relative educational achievement. Setting candidate gender as the protected attribute and gender level *female* as baseline value, for a *male* student with values $(a, e, t, y)$, his *fair-twin* values $(\tilde{a}, \tilde{e}, \tilde{t}, \tilde{y})$, i.e., the values the student would have obtained, had he been *female*, are computed. These values can be retrieved from a `fairadapt` object by calling the S3-generic function `fairTwins()` as:

```{r, fairtwin-uni}
ft_basic <- fairTwins(basic, train.id = seq_len(n_samp))
head(ft_basic, n = 3)
```

In this example, we compute the values in a *female* world. Therefore, for *female* applicants, the values remain fixed, while for *male* applicants the values are adapted, as can be seen from the output. Having access to explicit counterfactual instances as above may help justify fair decisions in practice or help guide the choice of the assumed causal model and resolving variables (see Section \ref{sec:extensions} for resolving variables).

# Uncertainty quantification {#sec:uncq}

The user might naturally be interested in uncertainty quantification of the procedure performed in `fairadapt()`. In order to explain how this can be achieved, we give a visualization of the typical workflow when using `fairadapt()` (see Figure \ref{fig:workflow-tikz}).

```{tikz, workflow-tikz, fig.cap = "The typical workflow when using \\pkg{fairadapt}. The shaded region represents the fair pre-processing which happens within the \\pkg{fairadapt} package. Often, this is followed by applying a regressor or a classifier to the transformed data, in order to obtain fair predictions. The latter part is up to the user and not included in \\pkg{fairadapt}.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "100%"}

<<setup-graph>>

\begin{tikzpicture}

  \pgfsetarrows{latex-latex};

  \begin{scope}
    \fill [colone!60, label={above left:{Ctf-fair}}] (-0.75, -0.6) rectangle (3.6*\myx+1.6, -3.3);
    
    \draw[] (-0.75, -0.6) rectangle (3.6*\myx+1.6, -3.3);

    \node (train) at (0, -1) {$\mathcal{D}_{train}$};
    \node (graph) at (0, -2) {graph $\mathcal{G}$};

    \node[f1] (fairadapt) at (\myx, -1.5) {\texttt{fairadapt()}};

    \node (traintransform) at (2.25*\myx, -1) {$\widetilde{\mathcal{D}}_{train}$};
    \node (fairadapts3) at (2.25*\myx, -2) {\texttt{fairadapt}\\ S3-object};
    \node (test) at (2.25*\myx, -3) {$\mathcal{D}_{test}$};

    \node[f1] (predict0) at (3.5*\myx, -2.5) {\texttt{predict()}};

    \node (testtransform) at (4*\myx, -1) {$\widetilde{\mathcal{D}}_{test}$};

    \node[f1] (predict1) at (5*\myx, 0) {\texttt{predict()}};

    \node (yhat) at (6*\myx, 0) {$\widehat{Y}^{fair}_{test}$};

    \node[f1] (classreg) at (2.5 * \myx, 1.5) {\texttt{classifier()} \\ \texttt{regressor()}};

    \node (classregs3) at (4*\myx, 1) {predictor S3-object};

    \draw[-Stealth] (train) to (fairadapt);
    \draw[-Stealth] (graph) to (fairadapt);

    \draw[-Stealth] (fairadapt) to (traintransform);
    \draw[-Stealth] (fairadapt) to (fairadapts3);

    \draw[-Stealth] (fairadapts3) to (predict0);
    \draw[-Stealth] (test) to (predict0);

    \draw[-Stealth] (predict0) to (testtransform);
    \draw[-Stealth] (testtransform) to (predict1);
    \draw[-Stealth] (predict1) to (yhat);

    \draw[-Stealth] (train) to (classreg);
    \draw[-Stealth] (traintransform) to (classreg);
    \draw[-Stealth] (classreg) to (classregs3);
    \draw[-Stealth] (classregs3) to (predict1);
  \end{scope}

\end{tikzpicture}
```

Such a workflow can be described as follows. We start from the training data $\mathcal{D}_{train}$ and the causal graph $\mathcal{G}$. These two arguments are used as inputs of the `fairadapt()` function, which returns a `fairadapt` S3 object (which also contains the transformed test data $\widetilde{\mathcal{D}}_{train}$). The `fairadapt` object, together with the test data $\mathcal{D}_{test}$, is then used as a input to the `predict()` function. The `predict()` function returns the transformed test data $\widetilde{\mathcal{D}}_{test}$. Often, the end goal is to obtain fair predictions on some new test data ${\mathcal{D}}_{test}$. To do so, we need to train a classifier/regressor. Either the training data $\mathcal{D}_{train}$ or its transformed counterpart $\widetilde{\mathcal{D}}_{train}$ can be used for building a predictor. The predictor then needs to be applied to the transformed train data $\widetilde{\mathcal{D}}_{test}$. Building on the graphical visualization in Figure \ref{fig:workflow-tikz}, which serves as a mental map of our workflow, we can now explain the distinct sources of uncertainty that can be considered:

- **Finite sample uncertainty**: The first, commonly encountered source of uncertainty is the one induced by finite sample size. The training data $\mathcal{D}_{train}$ has a finite size, and for this reason inferences made using this data are imperfect. We wish to quantify the uncertainty in the predictions $\widehat{Y}^{fair}_{test}$ introduced by the finite sample size of $\mathcal{D}_{train}$. As Figure \ref{fig:workflow-tikz} shows, the training data $\mathcal{D}_{train}$ affects the resulting fair predictions in two ways. Firstly, it affects the value of the transformed test data $\widetilde{\mathcal{D}}_{test}$ (mediated by the `fairadapt` S3 object). Secondly, it affects the predictions $\widehat{Y}^{fair}_{test}$ through the predictor (since it is the input to the regressor/classifier). These finite sample uncertainties can be analyzed using *bootstrap* \citep{efron1994introduction}. This means that we repeat the procedure in Figure \ref{fig:workflow-tikz} many times, each time taking a different bootstrap sample of the training data. Below we will show how this can be done with the `fairadaptBoot()` function.

- **Inherent uncertainty in the quantiles**: A second source of uncertainty arises from the uncertainty in quantile estimation and is specific to \pkg{fairadapt}. As described in Section \ref{methodology} (see also Figure \ref{fig:quantmap}), the `fairadapt()` procedure aims to preserve the relative quantile of the variable, when computing the $do(A=a)$ intervention. However, when we are working with variables that are not continuous, defining a quantile becomes more difficult\footnote{For example in the case where we have a binary $X \in \lbrace 0, 1 \rbrace$, it is impossible to define what a 70\% quantile is, as opposed to the continuous case (of a Gaussian variable $X$ for example), where no such challenge exists.}. Therefore, in presence of discrete variables, due to the imperfect estimation of quantiles, the `fairadapt()` procedure has some inherent randomness. This randomness would still persist even if we had infinite training samples in $\mathcal{D}_{train}$. Importantly, to achieve fair predictions, taking an expectation over this randomness is not feasible. For a detailed discussion of why this is the case, refer to \citep[Section~5]{plecko2020fair}.

For quantifying uncertainty, we use the `fairadaptBoot()` function, where the most important arguments are:

- `formula`, `prot.attr`, `adj.mat`, and `train.data` arguments are the same as for the `fairadapt()` function (see Section \ref{implementation}).
- `test.data`, a `data.frame` containing the test data, defaults to `NULL`. Whenever the test data equals `NULL`, then `keep.object` must be `TRUE`.
- `keep.object`, a `logical` scalar, indicating whether all the `fairadapt` S3 objects built in bootstrap repetitions should be kept in working memory. Default value is `FALSE`.
- `rand.mode`, a `character` scalar, taking values `"finsamp"`, `"quant"`, or `"both"`, corresponding to considering finite sample uncertainty, quantile uncertainty, or both.

The function `fairadaptBoot()` returns an S3 object of class `fairadaptBoot`. Calling this function can be computationally expensive, both in terms of runtime and memory. Keeping the default value of `FALSE` for the `keep.object` argument reduces the memory consumption substantially, with the drawback that `test.data` has to be provided directly to `fairadaptBoot()`, and that the resulting `fairadaptBoot` object cannot be reused for making predictions at a later stage. Passing `TRUE` to `save.object`, on the other hand, might consume more memory, but then the object can be reused for transforming new test data. This can be done by using the `predict()` function for the `fairadaptBoot` S3 object, to which a `newdata` argument is available.

For illustration purposes, we now compute bootstrap repetitions for finite sample uncertainty and quantile uncertainty on the COMPAS dataset \citep{larson2016compas}. We begin by loading the COMPAS dataset and constructing its causal graph:

```{r, compas}
cmp_dat <- data("compas", package = "fairadapt")
cmp_dat <- get(cmp_dat)

cmp_mat <- matrix(0, nrow = ncol(cmp_dat), ncol = ncol(cmp_dat),
                  dimnames = list(names(cmp_dat), names(cmp_dat)))

cmp_mat[c("race", "sex", "age"),
        c("juv_fel_count", "juv_misd_count",
          "juv_other_count", "priors_count",
          "c_charge_degree", "two_year_recid")] <- 1
cmp_mat[c("juv_fel_count", "juv_misd_count", "juv_other_count"),
        c("priors_count", "c_charge_degree", "two_year_recid")] <- 1
cmp_mat["priors_count", c("c_charge_degree", "two_year_recid")] <- 1
cmp_mat["c_charge_degree", "two_year_recid"] <- 1

head(cmp_dat)
```

The COMPAS dataset contains information on 7214 individuals from Broward County, Florida, who were released on parole. The variables include race, sex, age, juvenile offense counts, priors count and the degree of criminal charge. The outcome of interest is recidivism within two years and the protected attribute is race (taking values Non-White and White). A possible causal graph for the COMPAS dataset is given in Figure \ref{fig:compas-graph}.

```{tikz, compas-graph, fig.cap = "The causal graph for the COMPAS dataset. $Z$ are demographic features, $A$ is race, $J$ juvenile offense counts, $P$ priors count, $D$ the degree of charge, and $Y$ two year recidivism.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "40%"}

<<setup-graph>>

\begin{tikzpicture}

  \pgfsetarrows{latex-latex};

  \begin{scope}
	 	\node[rv] (c) at (0.5,2) {$\pmb{Z}$};
	 	\node[rv] (a) at (-2,2) {$A$};
	 	\node[rv] (m) at (-3,0) {$\pmb{J}$};
	 	\node[rv] (l) at (-1.5,0) {$P$};
	 	\node[rv] (r) at (0,0) {${D}$};
	 	\node[rv] (y) at (1.5,0) {$Y$};
	 	\draw[->] (c) -- (m);
	 	\draw[->] (c) -- (l);
	 	\draw[->] (c) -- (r);
	 	\draw[->] (c) -- (y);
	 	\draw[->] (a) -- (m);
	 	\draw[->] (m) -- (l);
	 	\draw[->] (l) -- (r);
	 	\draw[->] (r) -- (y);
	 	\path[->] (a) edge[bend left = 0] (l);
	 	\path[->] (a) edge[bend left = 0] (r);
	 	\path[->] (a) edge[bend left = 0] (y);
	 	\path[->] (m) edge[bend right = 25] (r);
	 	\path[->] (m) edge[bend right = 30] (y);
	 	\path[->] (l) edge[bend right = 25] (y);
		\path[<->,dashed] (a) edge[bend left = 10](c);
  \end{scope}

\end{tikzpicture}
```

After loading the dataset, we run the `fairadaptBoot()` function twice, with two different values of the `rand.mode` argument. First, we consider only the finite sample uncertainty.

```{r, compas-boot-quick, eval = quick_build, echo = quick_build}
cmp_trn <- tail(cmp_dat, n = 100L)
cmp_tst <- head(cmp_dat, n = 100L)

n_itr <- 3L

set.seed(2022)
fa_boot_fin <- fairadaptBoot(two_year_recid ~ ., "race", cmp_mat,
                             cmp_trn, cmp_tst, rand.mode = "finsamp",
                             n.boot = n_itr)
```

```{r, compas-boot-slow, eval = !quick_build, echo = !quick_build}
cmp_trn <- tail(cmp_dat, n = 6000L)
cmp_tst <- head(cmp_dat, n = 1214L)

n_itr <- 50L

set.seed(2022)
fa_boot_fin <- fairadaptBoot(two_year_recid ~ ., "race", cmp_mat,
                             cmp_trn, cmp_tst, rand.mode = "finsamp",
                             n.boot = n_itr)
```

Then, we re-run the bootstrap procedure, but by considering only the inherent quantile uncertainty, by setting the `rand.mode` argument to `"quant"`.

```{r, compas-boot-quant}
set.seed(2022)
fa_boot_quant <- fairadaptBoot(two_year_recid ~ ., "race", cmp_mat,
                               cmp_trn, cmp_tst, rand.mode = "quant",
                               n.boot = n_itr)
```

The returned objects are of class `fairadaptBoot`. The object stores different replicates of the adapted test data (`n.boot` copies, the number of bootstrap repetitions) and some metadata. To obtain predictions, we train a random forest classifier on different bootstrap samples of `train.data`, and apply it to the transformed data bootstrap replicates. In doing so, we make use of the `boot.ind` list, contained in the `fairadaptBoot` object, representing row indices of all bootstrap repetitions.

```{r, compas-forest}
fit_rf <- function(x) {
  ranger(factor(two_year_recid) ~ ., cmp_trn[x, ], probability = TRUE)
}

extract_pred <- function(x) x$predictions[, 2L]

set.seed(2022)
cmp_rf <- lapply(fa_boot_fin$boot.ind, fit_rf)

pred_fin <- Map(predict, cmp_rf, adaptedData(fa_boot_fin, train = FALSE)) 
pred_fin <- do.call(cbind, lapply(pred_fin, extract_pred))

pred_quant <- Map(predict, cmp_rf, adaptedData(fa_boot_quant, train = FALSE))
pred_quant <- do.call(cbind, lapply(pred_quant, extract_pred))
```

## Analyzing the uncertainty

In order to analyze the different sets of predictions $\widehat{Y}^{fair}_{test}$, two slightly different perspectives can be taken, and we elaborate on both in the following sections.

### Decision-maker analysis

The first way to analyze the uncertainty of the predictions is from the viewpoint of the decision-maker. By decision-maker, in this context we refer to the individual performing the analysis and obtaining a set of fair predictions. For a decision-maker, it is important to understand how sensitive the outcome of the classification is to uncertainties induced by both finite sample size and the inherent uncertainty induced by discrete variables. Let $p_A$ be the vector of predicted probabilities on the `test.data`, with length `nrow(test.data)`. Denote `nrow(test.data)` with $n_{test}$. Let $p_B$ be another vector of predicted probabilities (under a different bootstrap repetition). We can consider the following four metrics of uncertainty:

```{=latex}
\begin{enumerate}

\item For each threshold $t \in [0, 1]$, we compute the decision sets $D_A$, $D_B$, which are obtained by selecting all individuals for whom the value of $p_A \geq t$ (and $p_B$ respectively). We can then compute the Jaccard similarity of decision sets $D_A$, $D_B$, for each threshold $t$. By comparing many pairs of bootstrap repetitions in this way, we can estimate what the average Jaccard similarity for each threshold $t$ is. In practice, we may consider values of $t$ within a subset of $[0, 1]$, i.e., between the 5\% and 95\% quantiles of the predicted probabilities in the repetition corresponding to full data:
```

```{r, decision-maker-1}
jac_frm <- function(x, modes = "single") {

  jac <- function(a, b) {
    intersection <- length(intersect(a, b))
    union <- length(a) + length(b) - intersection
    intersection / union
  }

  res <- lapply(
    seq(quantile(x[, 1L], 0.05), quantile(x[, 1L], 0.95), 0.01),
    function(tsh) {

      ret <- replicate(100L, {
        col <- sample(ncol(x), 2L)
        jac(which(x[, col[1L]] > tsh), which(x[, col[2L]] > tsh))
      })

      data.frame(tsh = tsh, y = mean(ret), sd = sd(ret),
                 mode = modes)
    }
  )

  do.call(rbind, res)
}

jac_df <- rbind(jac_frm(pred_fin, "Finite Sample"),
                jac_frm(pred_quant, "Quantiles"))
```

```{=latex}
\item Consider two indices $i, j$ of the vectors $p_A, p_B$ such that $i \neq j$, corresponding to two distinct individuals. For such pairs of individuals $(i, j)$ we can analyze the probability $P((p_A)_i \geq (p_B)_j)$, where we can consider $i, j$ to be drawn randomly, and $p_A, p_B$ resulting from two random bootstrap repetitions. This probability tells us how likely it is that two randomly selected individuals appear in the same order in two repetitions.
```

```{r, decision-maker-2}
ord_ind <- function(x, modes = "single") {

  res <- replicate(5000L, {
    row <- sample(nrow(x), 2)
    ord <- mean(x[row[1], ] > x[row[2], ])
    max(ord, 1 - ord)
  })

  data.frame(res = res, mode = modes)
}

ord_df <- rbind(ord_ind(pred_fin, "Finite Sample"),
                ord_ind(pred_quant, "Quantiles"))
```

```{=latex}
\item Another interesting metric is the inversion number. Notice that $p_A, p_B$ define two permutations of the $n_{test}$ individuals, when we consider a ranking of individuals according to their predicted probabilities. We can compute the inversion number of these two permutations $\pi_A, \pi_B$, which is the total number of pairs of individuals whose ordering is not the same in $\pi_A$ and $\pi_B$. Notice that the maximum value of the inversion number is $\binom{n_{test}}{2}$. Hence, we normalize this quantity accordingly.
```

```{r, decision-maker-3}
inv_frm <- function(x, modes = "single") {

  gt <- function(x) x[1L] > x[2L]

  res <- replicate(100L, {
    col <- sample(ncol(x), 2L)
    prm <- order(x[, col[2L]][order(x[, col[1L]])])
    sum(combn(prm, 2L, gt)) / choose(length(prm), 2L)
  })

  data.frame(res = res, mode = modes)
}

inv_df <- rbind(inv_frm(pred_fin, "Finite Sample"),
                inv_frm(pred_quant, "Quantiles"))
```

```{=latex}
\item For each individual $i$, we can take the 5\% and 95\% quantiles of predicted probabilities in all of the \texttt{n.boot} bootstrap repetitions. We analyze the width of this interval across all individuals.
```

```{r, decision-maker-4}
prb_frm <- function(x, modes = "single") {
  qnt <- apply(x, 1L, quantile, probs = c(0.05, 0.95))
  data.frame(width = qnt[2L, ] - qnt[1L, ], mode = modes)
}

prb_df <- rbind(prb_frm(pred_fin, "Finite Sample"),
                prb_frm(pred_quant, "Quantiles"))
```

```{=latex}
\end{enumerate}
```

The results of these four metrics applied to different bootstrap repetitions on the COMPAS dataset are shown in Figure \ref{fig:compas-dm}.

```{r, compas-dm, echo = FALSE, fig.width = 8, fig.height = 6, fig.cap = "Analyzing uncertainty of predictions in the COMPAS dataset from decision-maker's point of view. Panel A shows how the Jaccard similarity of two repetitions varies depending on the decision threshold. Panel B shows the cumulative distribution of the random variable that indicates whether two randomly selected individuals preserve order (in terms of predicted probabilities) in bootstrap repetitions. Panel C shows the density of the normalized inversion number of between predicted probabilities in bootstrap repetitions. Panel D shows the cumulative distribution function of the 95\\% confidence interval (CI) width for the predicted probability of different individuals.", out.width = "100%"}

p1 <- ggplot(jac_df, aes(x = tsh, y = y, color = mode)) +
  geom_point() +
  geom_line() +
  geom_ribbon(aes(ymin = y - sd, ymax = y + sd, fill = mode, color = mode),
                alpha = 0.3) +
  theme_bw() +
  xlab("Decision threshold") +
  ylab("Jaccard similarity") +
  theme(
    legend.position = c(0.3, 0.3),
    legend.box.background = element_rect()
  ) +
  scale_color_discrete(labels = c(" \"finsamp\" ", " \"quant\" "),
                      name = "rand.mode") +
  scale_fill_discrete(labels = c(" \"finsamp\" ", " \"quant\" "),
                      name = "rand.mode")

p2 <- ggplot(ord_df, aes(x = res, color = mode)) +
  stat_ecdf() +
  theme_bw() +
  xlab("Probability of preserving ordering") +
  ylab("Cumulative proportion") +
  theme(
    legend.position = c(0.3, 0.7),
    legend.box.background = element_rect()
  ) +
  scale_color_discrete(labels = c(" \"finsamp\" ", " \"quant\" "),
                       name = "rand.mode")

p3 <- ggplot(inv_df, aes(x = res, fill = mode)) +
  geom_density(alpha = 0.3) +
  xlim(0, 0.25) +
  theme_bw() +
  xlab("Normalized inversion number") +
  ylab("Density") +
  theme(
    legend.position = c(0.3, 0.7),
    legend.box.background = element_rect()
  ) +
  scale_fill_discrete(labels = c(" \"finsamp\" ", " \"quant\" "),
                      name = "rand.mode")

p4 <- ggplot(prb_df, aes(x = width, color = mode)) +
  stat_ecdf() +
  theme_bw() +
  xlab("95% CI width") +
  ylab("Cumulative probability") +
  theme(
    legend.position = c(0.3, 0.7),
    legend.box.background = element_rect()
  ) +
  scale_x_reverse() +
  scale_color_discrete(labels = c(" \"finsamp\" ", " \"quant\" "),
                       name = "rand.mode")

cowplot::plot_grid(
  p1, p2, p3, p4, ncol = 2L, labels = LETTERS[1:4]
)
```

### Individual analysis

The other point of view we can take in quantifying uncertainty is that of the individual experiencing fair decisions. In this case, we are not so much interested in how much the overall decision set changes (as was the case above), but rather how much variation there is in the estimate for the specific individual. To this end, one might investigate the spread of the predicted values for a specific individual. The spread of the predictions for the first three individuals can be obtained as follows:

```{r, indiv-uncq}
ind_prb <- data.frame(
  prob = as.vector(t(pred_quant[seq_len(3), ])),
  individual = rep(c(1, 2, 3), each = fa_boot_quant$n.boot)
)
```

This spread is visualized in Figure \ref{fig:compas-indiv}. While it might be tempting to take the mean of the different individual predictions, to have more stable results, this should not be done, as such an approach does not guarantee the fairness constraint `fairadapt()` aims to achieve. Hence, in order to achieve the desired fairness criteria overall, we have to accept some level of randomization at the level of individual predictions. It would be interesting for future work to quantify and optimize explicitly the trade-off between the desired fairness criteria and the necessary level of randomization.

```{r, compas-indiv, echo = FALSE, fig.width = 7, fig.height = 3.5, fig.cap = "Analyzing the spread of individual predictions in the COMPAS dataset, resulting from different bootstrap repetitions.", out.width = "100%"}
ggplot(ind_prb, aes(x = prob, group = individual,
                    fill = factor(individual))) +
  geom_density(alpha = 0.2) +
  scale_fill_discrete(labels = paste0("#", seq_len(3)),
                      name = "Individual") +
  xlab("Probability Estimate") +
  ylab("Density") +
  theme_bw() +
  xlim(0, 1) +
  theme(
    legend.position = c(0.7, 0.75),
    legend.box.background = element_rect()
  )
```

# Illustration

As a hypothetical real-world use of \pkg{fairadapt}, suppose that after a legislative change the US government has decided to adjust the salary of all of its female employees in order to remove both disparate treatment and disparate impact effects. To this end, the government wants to compute the counterfactual salary values of all male employees, that is the salaries that male employees would obtain, had they been female (i.e., the female group serves as the baseline).

To do this, the government is using data from the 2018 American Community Survey by the US Census Bureau. This dataset is also available in pre-processed form as a package dataset from \pkg{fairadapt}. Columns are grouped into demographic (`dem`, including age, race, origin, citizenship, and economic region), familial (`fam`, including marital status, size of the family, and number of children), educational (`edu`, including number of years spent in schooling and the level of English proficiency) and occupational (`occ`, including the hours and week worked every year, occupation category, and industry of employment) categories and finally, salary is selected as response (`res`) and sex as the protected attribute (`prt`):

```{r, load-census}
gov_dat <- data("gov_census", package = "fairadapt")
gov_dat <- get(gov_dat)

dem <- c("age", "race", "hispanic_origin", "citizenship",
         "nativity", "economic_region")
fam <- c("marital", "family_size", "children")
edu <- c("education_level", "english_level")
occ <- c("hours_worked", "weeks_worked", "occupation",
         "industry")

prt <- "sex"
res <- "salary"
```

The hypothesized causal graph for the dataset is given in Figure \ref{fig:census-tikz}. According to this, the causal graph can be specified as an adjacency matrix `gov_adj` and as confounding matrix `gov_cfd`:

```{tikz, census-tikz, fig.cap = "The causal graph for the government-census dataset. $D$ are demographic features, $A$ is gender, $F$ represents marital and family information, $E$ education, $W$ work-related information and $Y$ the salary, which is also the outcome of interest. The bidirected edge between $A$ and $D$ represents that the noise variables $U_A$ and $U_D$ share information.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "50%"}

<<setup-graph>>

\begin{tikzpicture}

  \pgfsetarrows{latex-latex};

  \begin{scope}
    \node[rv] (c) at (2,2) {$D$};
    \node[rv] (a) at (-2,2) {$A$};
    \node[rv] (m) at (-3,0) {$F$};
    \node[rv] (l) at (-1,0) {$E$};
    \node[rv] (r) at (1,0) {$W$};
    \node[rv] (y) at (3,0) {$Y$};
    \draw[->] (c) -- (m);
    \draw[->] (c) -- (l);
    \draw[->] (c) -- (r);
    \draw[->] (c) -- (y);
    \draw[->] (a) -- (m);
    \draw[->] (m) -- (l);
    \draw[->] (l) -- (r);
    \draw[->] (r) -- (y);
    \path[->] (a) edge[bend left = 0] (l);
    \path[->] (a) edge[bend left = 0] (r);
    \path[->] (a) edge[bend left = 0] (y);
    \path[->] (m) edge[bend right = 20] (r);
    \path[->] (m) edge[bend right = 30] (y);
    \path[->] (l) edge[bend right = 20] (y);
    \path[<->, dashed] (a) edge[bend left = 10] (c);
  \end{scope}

\end{tikzpicture}
```

```{r, census-adj}
cols <- c(dem, fam, edu, occ, prt, res)

gov_adj <- matrix(0, nrow = length(cols), ncol = length(cols),
                  dimnames = rep(list(cols), 2))
gov_cfd <- gov_adj

gov_adj[dem, c(fam, edu, occ, res)] <- 1
gov_adj[fam, c(     edu, occ, res)] <- 1
gov_adj[edu, c(          occ, res)] <- 1
gov_adj[occ,                  res ] <- 1

gov_adj[prt, c(fam, edu, occ, res)] <- 1

gov_cfd[prt, dem] <- 1
gov_cfd[dem, prt] <- 1

gov_grph <- graphModel(gov_adj, gov_cfd)
```

A visualization of the full graph using \pkg{igraph} is shown in Figure \ref{fig:census-graph}.
```{r, census-graph, echo = FALSE, fig.height = 9, fig.width = 9, fig.cap = "Full causal graph for the government census dataset, expanding the grouped view presented in Figure \\ref{fig:census-tikz}. \\textit{Demographic} features include age (\\textbf{ag}), race (\\textbf{ra}), whether an employee is of Hispanic origin (\\textbf{hi}), is US citizen (\\textbf{ci}), whether the citizenship is native (\\textbf{na}), alongside the corresponding economic region (\\textbf{ec}). \\textit{Familial} features are marital status (\\textbf{ma}), family size (\\textbf{fa}) and number of children (\\textbf{ch}), \\textit{educational} features include education (\\textbf{ed}) and English language levels (\\textbf{en}), and \\textit{occupational} features, weekly working hours (\\textbf{ho}), yearly working weeks (\\textbf{we}), job (\\textbf{oc}) and industry identifiers (\\textbf{in}). Finally, the yearly salary (\\textbf{sa}) is used as the \\textit{response} variable and employee sex (\\textbf{se}) as the \\textit{protected} attribute variable.", out.width = "90%"}
set.seed(11)
gov_tmp <- graphModel(
  `dimnames<-`(gov_adj, lapply(dimnames(gov_adj), substr, 1L, 2L)),
  `dimnames<-`(gov_cfd, lapply(dimnames(gov_cfd), substr, 1L, 2L))
)

grp <- list(dem, fam, edu, occ, prt, res)
grp <- `names<-`(
  rep(c("demographic", "familial", "educational", "occupational",
        "protected", "response"), lengths(grp)),
  substr(unlist(grp), 1L, 2L)
)

igraph::V(gov_tmp)$color <- grp[names(igraph::V(gov_tmp))]

gov_tmp <- igraph::delete_edges(
  gov_tmp, which(igraph::E(gov_tmp)$lty == "blank")
)

lty_selector <- function(lty) {
  function(layout) {
    get_all <- get_edges()
    edges <- get_all(layout)
    res <- edges[edges$lty == lty, ]
    res
  }
}

ggraph(gov_tmp, "igraph", algorithm = "fr") +
  geom_edge_arc(data = lty_selector("dashed"),
                arrow = arrow(length = unit(4, "mm"), angle = 15,
                              ends = "both", type = "closed"),
                start_cap = circle(6.5, "mm"),
                end_cap = circle(6.5, "mm"),
                strength = 0.25,
                color = "grey20",
                linetype = "dashed") +
  geom_edge_link(data = lty_selector("solid"),
                 arrow = arrow(length = unit(4, "mm"), angle = 15,
                               type = "closed"),
                 end_cap = circle(6.5, "mm"),
                 color = "grey20",
                 linetype = "solid") +
  geom_node_point(aes(color = color), size = 15) +
  geom_node_text(aes(x = x, y = y, label = name), size = 5) +
  scale_edge_linetype_manual(values = c(dashed = "dashed", solid = "solid")) +
  scale_color_discrete(name = "Grouping") +
  theme_bw() +
  theme(plot.margin = margin(30, 30, 30, 30), legend.position = "bottom",
        panel.background = element_blank(), axis.title = element_blank(),
        axis.text = element_blank(), axis.line = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank(),
        panel.border = element_blank()) +
  coord_cartesian(clip = "off")
```

Before applying `fairadapt()`, we first log-transform the salaries to avoid dealing with a possibly heavy-tailed distribution for which quantile estimation may be more difficult. We then inspect the densities of variable `salary` by sex group, as shown in Figure \ref{fig:census-vis}A. There is a clear shift between the two distributions, indicating that `male` employees are better compensated than `female` employees. We perform the adaptation by using `n_samp` samples for training and `n_pred` samples for testing.

```{r, log-sub-quick, eval = quick_build, echo = quick_build}
n_samp <- 750
n_pred <- 5
```

```{r, log-sub-slow, eval = !quick_build, echo = !quick_build}
n_samp <- 30000
n_pred <- 5
```

```{r, census-adapt}
gov_dat$salary <- log(gov_dat$salary)

gov_trn <- head(gov_dat, n = n_samp)
gov_prd <- tail(gov_dat, n = n_pred)

set.seed(22)
gov_ada <- fairadapt(salary ~ ., train.data = gov_trn,
                     adj.mat = gov_adj, cfd.mat = gov_cfd,
                     prot.attr = prt)
```

After adapting the data, we investigate whether the salary gap has become smaller. This can be done by comparing distributions of variable `salary` using the \pkg{ggplot2}-exported S3 generic function `autoplot()` (Figure \ref{fig:census-vis}B).
```{r, census-vis, echo = FALSE, fig.width = 7, fig.height = 3, fig.cap = "Visualization of salary densities grouped by employee sex, before (panel A) and after adaptation (panel B). Panel A indicates a shift towards higher values for male employees. In panel B, after the data is transformed, the gap between groups is reduced.", cache = TRUE}

p1 <- ggplot(gov_trn, aes(x = salary, fill = sex)) +
  geom_density(alpha = 0.4)  +
  theme_bw()

p2 <- autoplot(gov_ada, when = "after") +
  theme_bw() + ggtitle(NULL)

legend_join <- cowplot::get_legend(
  p1 + guides(color = guide_legend(nrow = 1)) +
    theme(legend.position = "bottom")
)

panels <- cowplot::plot_grid(
  p1 + theme(legend.position = "none"), 
  p2 + theme(legend.position = "none"), labels = LETTERS[1:2]
)
cowplot::plot_grid(panels, legend_join, ncol = 1, rel_heights = c(1, .08))
```
For adapting additional testing data, we use the base \proglang{R} S3 generic function `predict()` and output a selection of columns:

```{r, census-predict}
set.seed(2022)
gov_prd_ada <- predict(gov_ada, newdata = gov_prd)
gov_prd_ada[, c("sex", "age", "education_level", "salary")]
```

Finally, we can do fair-twin inspection using the `fairTwins()` function of \pkg{fairadapt}, to retrieve counterfactual values of some features for different individuals:

```{r, census-twins}
fairTwins(gov_ada, train.id = 1:5,
          cols = c("sex", "age", "salary"))
```

Note that values remain unchanged for female individuals (as *female* was used as baseline level). Variable `age`, which is not a descendant of the protected attribute `sex` (see Figure \ref{fig:census-graph}), also remains unchanged. However, variables `education_level` and `salary` do change for males, since these variables are descendants of the protected attribute `sex`.

We conclude the section with a remark. Notice that the variable `hours_worked` is a descendant of $A$. However, one might argue that this variable should *not* be adapted in the procedure, i.e., it should remain the same, irrespective of employee sex. In other words, one might argue it is acceptable to distinguish individuals based on this variable. This is the idea behind *resolving variables*, which are discussed in Section \ref{sec:resolvers}. It is worth emphasizing that we are not answering the question of how to choose which variables are resolving - this choice is left to social scientists familiar with the context of the dataset.

# Extensions {#sec:extensions}

Several extensions to the basic Markovian SCM formulation introduced in Section \ref{markovian-scm-formulation} exist, and these are outlined in the following sections.

## Adding resolving variables {#sec:resolvers}

As we mentioned earlier, in some situations the protected attribute $A$ might affect other variables in a non-discriminatory way. For instance, in the Berkeley admissions dataset \citep{bickel1975sex} we observe that females often apply for departments with lower admission rates and consequently have a lower admission probability. However, we perhaps would not wish to account for this difference in the adaptation procedure, if we were to argue that applying to a certain department is a choice everybody is free to make. Such examples motivated the idea of *resolving variables* by \citet{kilbertus2017avoiding}. A variable $R$ is called resolving if

(i) $R \in \de(A)$, where $\de(A)$ are the descendants of $A$ in the causal graph $\mathcal{G}$.
(i) The causal effect of $A$ on $R$ is considered to be non-discriminatory.

In presence of resolving variables, computation of the counterfactual is carried out under the more involved intervention do$(A = a, R = R(a'))$. The potential outcome value $V(A = a, R = R(a'))$ is obtained by setting $A = a$ and computing the counterfactual while keeping the values of resolving variables to those they *attained naturally*. This is a nested counterfactual and the difference in Algorithm \ref{algo:fairadapt} is simply that resolving variables $R$ are skipped in the for-loop. In order to perform fair data adaptation with the variable `test` being resolving in the `uni_admission` dataset used in Section \ref{implementation}, the string `"test"` can be passed as `res.vars` to `fairadapt()`.

```{r, res-uni}
res_basic <- fairadapt(score ~ ., train.data = uni_trn, 
                       test.data = uni_tst, adj.mat = uni_adj, 
                       prot.attr = "gender", res.vars = "test")
summary(res_basic)
```

As can be seen from the respective model summary outputs, the total variation after adaptation, in this case, is larger than in the example from Section \ref{implementation}, with no resolving variables. The intuitive reasoning here is that resolving variables allow for some discrimination, so we expect to see a larger total variation between the groups.

```{r, res-assign}
uni_res <- graphModel(uni_adj, res.vars = "test")
```

```{r, res-graph, echo = FALSE, fig.width = 6, fig.height = 3, fig.cap = "Visualization of the causal graph corresponding to the university admissions example introduced in Section \\ref{introduction} with the variable \\texttt{test} chosen as a \\textit{resolving variable} and therefore highlighted in red.", out.width = "60%"}

set.seed(11)

ggraph(graphModel(uni_adj, res.vars = "test"), "igraph",
       algorithm = "sugiyama") +
  geom_edge_link(arrow = arrow(length = unit(4, "mm"), angle = 15,
                               type = "closed"),
                 end_cap = circle(8, "mm"),
                 color = "grey20") +
  geom_node_point(aes(color = color), size = 21, show.legend = FALSE) +
  geom_node_text(aes(x = x, y = y, label = name), size = 5) +
  theme_bw() +
  theme(plot.margin = margin(30, 30, 30, 30), panel.border = element_blank(),
        panel.background = element_blank(), axis.title = element_blank(),
        axis.text = element_blank(), axis.line = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank()) +
  coord_cartesian(clip = "off")
```

A visualization of the corresponding graph is available from Figure \ref{fig:res-graph}, which highlights the resolving variable `test` in red, but the underlying graphical model remains the same.

## Semi-Markovian and topological ordering variant

In Section \ref{methodology} we focused on the Markovian case, which assumes that all exogenous variables $U_i$ are mutually independent. However, in practice, this requirement is often not satisfied. If a mutual dependency structure between variables $U_i$ exists, we are speaking about Semi-Markovian models. In the university admission example, we might have that $U_{\text{test}} \not\!\perp\!\!\!\perp U_{\text{score}}$. That is, latent variables corresponding to variables test and final score being correlated. Such dependencies between latent variables can be represented by dashed, bidirected arrows in the causal diagram, as shown in Figures \ref{fig:semi-markov} and \ref{fig:semi-graph}.

```{tikz, semi-markov, fig.cap = "Causal graphical model corresponding to a Semi-Markovian variant of the university admissions example, introduced in Section \\ref{implementation}. Here, we allow for the possibility of a mutual dependency between the latent variables corresponding to variables `test` and `score`.", fig.ext = "png", cache = TRUE, echo = FALSE, out.width = "50%"}

<<setup-graph>>

\begin{tikzpicture}

  \pgfsetarrows{latex-latex};

  \begin{scope}
    \node[rv] (a) at (-3,0) {$A$};
    \node[rv] (v1) at (-1,0) {$E$};
    \node[rv] (v2) at (1,0) {$T$};
    \node[rv] (y) at (3,0) {$Y$};
    \draw[->] (a) -- (v1);
    \draw[->] (a) edge[bend left = 30] (v2);
    \draw[->] (v1) -- (v2);
    \draw[->] (v1) edge[bend left = 30] (y);
    \draw[->] (v2) -- (y);
    \path[<->, dashed] (v2) edge[bend right = 20] (y);
  \end{scope}

\end{tikzpicture}
```

There is an important difference in the adaptation procedure for the Semi-Markovian case: when inferring the latent quantiles $U_i$ of variable $V_i$, in the Markovian case, only the direct parents $\pa(V_i)$ are needed. In the Semi-Markovian case, due to correlation of latent variables, using only the $\pa(V_i)$ can lead to biased estimates of the $U_i$. Instead, the set of direct parents needs to be extended, as described in more detail by \citet{tian2002general}. A brief sketch of the argument goes as follows: Let the *C-components* be a partition of the set $V$, such that each *C-component* contains a set of variables which are mutually connected by bidirected edges. Let $C(V_i)$ denote the entire *C-component* of variable $V_i$. We then define the set of extended parents as

$$\Pa(V_i) := (C(V_i) \cup pa(C(V_i))) \cap \an(V_i),$$

where $\an(V_i)$ is the set of ancestors of $V_i$. The adaptation procedure in the Semi-Markovian case in principle remains the same as outlined in Algorithm \ref{algo:fairadapt}, with the difference that the set of direct parents $\pa(V_i)$ is replaced by $\Pa(V_i)$ at each step.

To include the bidirected edges in the adaptation, we can pass a `matrix` as `cfd.mat` argument to `fairadapt()` such that:

* `cfd.mat` has the same dimension, column and row names as `adj.mat`.
* `cfd.mat` is symmetric.
* As with the adjacency matrix `adj.mat`, an entry `cfd.mat[i, j] == 1` indicates that there is a bidirected edge between variables `i` and `j`.

The following code performs fair data adaptation of the Semi-Markovian university admission variant with a mutual dependency between the variables representing test and final scores. For this, we create a matrix `uni_cfd` with the same attributes as the adjacency matrix `uni_adj` and set the entries representing the bidirected edge between vertices `test` and `score` to $1$. Finally, we can pass this confounding matrix as `cfd.mat` to `fairadapt()`. A visualization of the resulting causal graph is available from Figure \ref{fig:semi-graph}.

```{r, semi-markov-uni}
uni_cfd <- matrix(0, nrow = nrow(uni_adj), ncol = ncol(uni_adj),
                  dimnames = dimnames(uni_adj))

uni_cfd["test", "score"] <- 1
uni_cfd["score", "test"] <- 1

semi <- fairadapt(score ~ ., train.data = uni_trn,
                   test.data = uni_tst, adj.mat = uni_adj,
                   cfd.mat = uni_cfd, prot.attr = "gender")
```

```{r, semi-graph, echo = FALSE, fig.width = 6, fig.height = 3, fig.cap = "Visualization of the causal graphical model also shown in Figure \\ref{fig:semi-markov}, obtained when passing a confounding matrix indicating a bidirected edge between vertices \\texttt{test} and \\texttt{score} to \\texttt{fairadapt()}. The resulting Semi-Markovian model can also be handled by \\texttt{fairadapt()}, extending the basic Markovian formulation introduced in Section \\ref{markovian-scm-formulation}.", out.width = "60%"}

set.seed(17)

ggraph(semi$graph, "igraph", algorithm = "fr") +
  geom_edge_arc(data = lty_selector("dashed"),
                arrow = arrow(length = unit(4, "mm"), angle = 15,
                              ends = "both", type = "closed"),
                start_cap = circle(8, "mm"),
                end_cap = circle(8, "mm"),
                strength = 0.25,
                color = "grey20",
                linetype = "dashed") +
  geom_edge_link(data = lty_selector("solid"),
                 arrow = arrow(length = unit(4, "mm"), angle = 15,
                               type = "closed"),
                 end_cap = circle(8, "mm"),
                 color = "grey20",
                 linetype = "solid") +
  geom_node_point(color = "grey80", size = 21) +
  geom_node_text(aes(x = x, y = y, label = name), size = 5) +
  theme_bw() +
  theme(plot.margin = margin(30, 30, 30, 30), panel.border = element_blank(),
        panel.background = element_blank(), axis.title = element_blank(),
        axis.text = element_blank(), axis.line = element_blank(),
        axis.ticks = element_blank(), panel.grid = element_blank()) +
  coord_cartesian(clip = "off")
```

Alternatively, instead of using the extended parent set $\Pa(V_i)$, we could also use the entire set of ancestors $\an(V_i)$. This approach is implemented as well, and available by specifying a topological ordering. This is achieved by passing a `character` vector, containing the correct ordering of the names appearing in `names(train.data)` as `top.ord` argument to `fairadapt()`. The benefit of using this option is that the specific edges of the causal model $\mathcal{G}$ need not be specified. However, in the linear case, specifying the edges of the graph, so that the quantiles are inferred using only the set of parents, will in principle have better performance. The topological variant can be invoked as follows:

```{r top-ord}
set.seed(2022)
top_ord <- fairadapt(score ~ ., train.data = uni_trn, test.data = uni_tst, 
                      top.ord = c("gender", "edu", "test", "score"),
                      prot.attr = "gender")

summary(top_ord)
```

Note that the topological variant for the university admissions dataset is the same as supplying the adjacency matrix, since the causal graph has no missing edges.

## Questions of identifiability

So far we did not discuss whether it is always possible to carry out the counterfactual inference described in Section \ref{methodology}. In the causal literature, an intervention is termed *identifiable* if it can be computed uniquely using the data and the assumptions encoded in the graphical model $\mathcal{G}$. An important result by \cite{tian2002general} states that an intervention do$(X = x)$ on a variable $X$ is identifiable if there is no bidirected path between $X$ and $\ch(X)$. Therefore, our intervention of interest is identifiable if one of the two following conditions are met:

* The model is Markovian.
* The model is Semi-Markovian and,
  (i) there is no bidirected path between $A$ and $\ch(A)$ and,
  (i) there is no bidirected path between $R_i$ and $\ch(R_i)$ for any resolving variable $R_i$.

Based on this, the `fairadapt()` function might return an error, if the specified intervention is not possible to compute. An additional limitation is that \pkg{fairadapt} currently does not support *front-door identification* \citep[Chapter~3]{pearl2009causality}, meaning that certain special cases, which are in principle identifiable, are currently not handled.

## Future avenues to be explored

We conclude with a brief look at the possible extensions of the \pkg{fairadapt} package, which we hope to consider in future work:

1. *Spurious pathways*: the \pkg{fairadapt} package allows for correcting discrimination along causal pathways from the protected attribute $A$ to outcome $Y$. However, it is also possible that $A$ and $Y$ are associated through a confounding mechanism, and correcting for such spurious association poses an interesting methodological and practical challenge. 

1. *General identification*: as discussed above, there are certain cases of causal graphs in which our do$(A = a, R = R(a'))$ intervention is identifiable, but the `fairadapt()` function currently does not support doing so. One of such examples is front-door identification, mentioned above. In a future version of \pkg{fairadapt}, we hope to cover all scenarios in which identification is possible.

1. *Path-specific effects*: when using resolving variables (Section \ref{sec:resolvers}), the user decides to label these variables as "non-discriminatory", that is, the algorithm is free to distinguish between groups based on these variables. In full generality, a user might be interested in considering all path-specific effects \citep{avin2005identifiability}. Such an approach would offer even more flexibility in modeling, since for every attribute-outcome path $A \rightarrow ... \rightarrow Y$, the user could decide whether it is fair or not.

1. *Selection bias*: a commonly considered problem in causal inference is that of selection bias \citep{hernan2004structural}, when inclusion of individuals into the dataset depends on the observed variables in the dataset. In fairness applications, the presence of selection bias could invalidate our conclusions about discrimination and make our fair predictions biased. Recovering from selection bias algorithmically would therefore be a desirable feature in the \pkg{fairadapt} package.

1. *Non-binary attribute $A$*: one assumption used currently is that the protected attribute $A$ is binary. When considering possible protected attributes as socioeconomic status or education, this assumption may need to be relaxed. We hope to address this in future work.

```{r session-info, include = FALSE}
sessionInfo()
```
