---
title: "Introduction to fairGATE"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Introduction to fairGATE}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 6, fig.height = 4)
has_torch <- requireNamespace("torch", quietly = TRUE) &&
  isTRUE(tryCatch(torch::torch_is_installed(), error = function(e) FALSE))
has_xgb <- requireNamespace("xgboost", quietly = TRUE) &&
  utils::packageVersion("xgboost") >= "3.1.0"
run_all <- has_torch && has_xgb
if (has_torch) torch::torch_set_num_threads(1L)
```

fairGATE corrects an existing prediction model so that its errors are spread
more evenly across protected groups, and reports for every person how far the
prediction was moved and how stable that adjustment is. This vignette walks
through the method on the Adult income sample shipped with the package (1,000
people from the UCI Adult data; outcome: income above USD 50,000; protected
attribute: sex), then shows a continuous outcome on simulated data with the
neural-network base learner.

The code chunks that fit models need the suggested packages torch (with its
LibTorch backend) and xgboost. `r if (run_all) "Both were available when this vignette was built, so every chunk was run." else "They were not available when this vignette was built, so the model-fitting chunks are shown but not run."`

## Data

```{r data}
library(fairGATE)
data("adult_ready_small", package = "fairGATE")
d <- adult_ready_small
y <- d$income
group <- as.integer(d$sex == "Female")        # 0 = male (reference), 1 = female
X <- as.matrix(d[, setdiff(names(d), c("income", "sex"))])
dim(X)
table(sex = group, income = y)
```

The protected attribute is kept out of `X`: fairGATE uses it only in the
fairness objective, in the target of the disparity signal and in evaluation.

## Step 1: a cross-fitted base learner

The base learner is any accurate model fitted without the protected
attribute. `fairgate_base_learner()` fits XGBoost or a neural network and
cross-fits it: training rows receive 5-fold out-of-fold scores, held-out rows
the prediction of a fit on all training rows.

```{r base, eval = has_xgb}
set.seed(2024)
test <- sort(sample(nrow(X), 200))
train <- setdiff(seq_len(nrow(X)), test)
b <- fairgate_base_learner(X, y, "binomial", train = train, test = test,
                           base_learner = "xgboost",
                           params = list(nrounds = 150, eta = 0.05, max_depth = 3))
b
```

With `params = NULL` the hyperparameters are tuned first on an inner split by
`fairgate_tune_base_learner()`; the default grids are listed by
`fairgate_base_grid("xgboost")` and `fairgate_base_grid("nn")`.

How unequal are the base learner's errors? `fairgate_group_disparity()`
reports the average odds difference (the mean of the true- and false-positive
rate gaps) at the prevalence-matched threshold, which flags positive the same
share of people as the training prevalence.

```{r base-disp, eval = has_xgb}
thr <- stats::quantile(b$test, 1 - mean(y[train]), names = FALSE)
fairgate_group_disparity(y[test], b$test, group[test], reference = 0,
                         family = "binomial", threshold = thr)$per_group
```

## Step 2: fairGATE in one call

`fairgate()` fits the base learner, the cross-fitted disparity signal,
searches the configuration space on an inner split, selects the configuration
with the smallest worst-group disparity among those within 0.01 of the best
validation AUC, and fits it with per-person stability intervals. The defaults
are the full protocol of the accompanying study (48 configurations, up to 300
epochs, 10 bootstrap replicates). To keep this vignette fast we search 4
configurations with at most 60 epochs and 3 replicates.

```{r fit, eval = run_all}
fit <- fairgate(X, y, group, family = "binomial", reference_group = 0,
                splits = list(list(train = train, test = test)),
                base_params = list(nrounds = 150, eta = 0.05, max_depth = 3),
                n_draws = 4, epochs = 60, interval_reps = 3, interval_epochs = 5)
fit
```

With only 1,000 people, women with high income are too few for the
minimum-cell rule of the study (at least 10 expected positives and negatives
per held-out set), so `fairgate()` warns and takes the worst group over all
groups. Missing values (24 people have no recorded country of birth) are
imputed with training-row medians inside every fit.

The search table shows each configuration's validation AUC and worst-group
disparity, and which one the rule selected.

```{r search, eval = run_all}
fit$search[, c("config_id", "coupling", "penalty", "lambda", "intervention_cost",
               "perf", "worst", "selected")]
```

Disparity before and after the correction, on the held-out rows:

```{r after, eval = run_all}
p <- fit$predictions
cmp <- function(score) {
  t <- stats::quantile(score, 1 - mean(y[train]), names = FALSE)
  fairgate_group_disparity(p$y, score, p$group, reference = 0,
                           family = "binomial", threshold = t)$worst
}
c(base = cmp(p$base), fairGATE = cmp(p$pred))
```

With 200 held-out people and one partition these numbers are noisy; the
study compares methods over 50 partitions with paired tests.

## Step 3: who was moved, and how reliably

`fairgate_export()` returns one row per held-out person: base score,
corrected score, adjustment, the weight left on the base learner, the routing
weights, and the bootstrap interval of the adjustment.

```{r export, eval = run_all}
ex <- fairgate_export(fit)
head(ex[, c("row", "group", "base", "pred", "adjustment", "base_weight",
            "adj_lo", "adj_hi", "interval_excludes_zero")])
```

Summaries by group show how the correction is distributed:

```{r by-group, eval = run_all}
aggregate(cbind(abs_adjustment = abs(adjustment), base_weight,
                stable = interval_excludes_zero) ~ group, data = ex, FUN = mean)
```

The intervals come from a small number of warm-started bootstrap replicates
and are not calibrated; they rank adjustments by stability rather than give
coverage. To write the export to a file use
`fairgate_export(fit, file.path(tempdir(), "fairgate_export.csv"))`.

## A continuous outcome with the neural-network base learner

For a continuous outcome the fairness criterion is the conditional mean
prediction difference within outcome strata, in outcome standard deviations.
Here the base learner is a torch multilayer perceptron, tuned on a small grid.

```{r cont, eval = has_torch}
set.seed(7)
n <- 1200
g2 <- sample(0:2, n, replace = TRUE, prob = c(0.6, 0.25, 0.15))
X2 <- cbind(x1 = rnorm(n) + 0.6 * g2, x2 = rnorm(n), x3 = rnorm(n))
y2 <- X2[, 1] + 0.5 * X2[, 2]^2 + rnorm(n)
fit2 <- fairgate(X2, y2, g2, family = "gaussian", reference_group = 0,
                 base_learner = "nn", signal_learner = "nn",
                 base_tune_args = list(n_search = 3, grid = list(epochs = 40L)),
                 n_draws = 3, epochs = 40, interval_reps = 0)
fit2
```

## Working with the building blocks

The one-call wrapper is built from exported functions that can be used
separately:

* `fairgate_base_learner()` and `fairgate_tune_base_learner()` for base scores
  per partition (for example to compare base learners);
* `train_gnn()` with `base_score = ` and `coupling = "residual"` or
  `"expert"` to correct base scores computed elsewhere;
* `fairgate_disparity_target()` for the disparity signal's target;
* `fairgate_group_disparity()` for per-group and worst-group disparity;
* `analyse_experts()`, `analyse_gnn_results()` and `plot_sankey()` for
  routing and expert analyses, and `export_f360_csv()` for the AI Fairness 360
  toolkit.

For reproducible neural-network fits call `torch::torch_set_num_threads(1)`
before fitting; with several threads the order of floating-point reductions
can change between runs.