## ----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)

## ----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)

## ----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

## ----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

## ----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

## ----search, eval = run_all---------------------------------------------------
fit$search[, c("config_id", "coupling", "penalty", "lambda", "intervention_cost",
               "perf", "worst", "selected")]

## ----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))

## ----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")])

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

## ----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