add fairness metrics

NAMESPACE

@@ -130,12 +130,16 @@ export(concordance_survival_vec)
 export(conf_mat)
 export(curve_metric_summarizer)
 export(curve_survival_metric_summarizer)
+export(demographic_parity)
 export(detection_prevalence)
 export(detection_prevalence_vec)
 export(dots_to_estimate)
 export(dynamic_survival_metric_summarizer)
+export(equal_opportunity)
+export(equalized_odds)
 export(f_meas)
 export(f_meas_vec)
+export(fairness_metric)
 export(finalize_estimator)
 export(finalize_estimator_internal)
 export(gain_capture)

NEWS.md

@@ -14,6 +14,8 @@ calculated with `roc_auc_survival()`.
 
 * `metric_set()` can now be used with a combination of dynamic and static survival metrics.
 
+* `demographic_parity()`, `equalized_odds()`, and `equal_opportunity()` are new metrics for measuring model fairness. Each is implemented with the `fairness_metric()` constructor, a general interface for defining group-aware metrics that allows for quickly and flexibly defining fairness metrics with the problem context in mind.
+
 # yardstick 1.2.0
 
 ## New Metrics

R/aaa.R

@@ -6,6 +6,7 @@ utils::globalVariables(
   c(
     # for class prob metrics
     "estimate",
+    ".estimator",
     "threshold",
     "specificity",
     ".level",

R/fair-aaa.R

@@ -0,0 +1,137 @@
+#' Create fairness metrics
+#'
+#' Fairness metrics quantify the disparity in value of a metric across a number
+#' of groups. Fairness metrics with a value of zero indicate that the
+#' underlying metric has parity across groups. yardstick defines
+#' several common fairness metrics using this function, such as
+#' [demographic_parity()], [equal_opportunity()], and [equalized_odds()].
+#'
+#' @param .fn A yardstick metric function or metric set.
+#' @param .name The name of the metric to place in the `.metric` column
+#' of the output.
+#' @param .post A function to post-process the generated metric set results `x`.
+#' In many cases, `~diff(range(x$.estimate))` or
+#' `~r <- range(x$.estimate); r[1]/r[2]`.
+#'
+#' @section Relevant Group Level:
+#' By default,
+#'
+#' Additional arguments can be passed to the function outputted by
+#' the function that this function outputs. That is:
+#'
+#' ```
+#' res_fairness <- fairness_metric(...)
+#' res_by <- res_fairness(by)
+#' res_by(..., additional_arguments_to_.post = TRUE)
+#' ```
+#'
+#' For finer control of how groups in `by` are treated, use the
+#' `.post` argument.
+#'
+#' @return A function with one argument, `by`, indicating the data-masked
+#' variable giving the sensitive feature. See the documentation on the
+#' return value of fairness metrics like [demographic_parity()],
+#' [equal_opportunity()], or [equalized_odds()] to learn more about how the
+#' output of this function can be used.
+#'
+#' @examples
+#' data(hpc_cv)
+#'
+#' # `demographic_parity`, among other fairness metrics,
+#' # is generated with `fairness_metric()`:
+#' diff_range <- function(x, ...) {diff(range(x$.estimate))}
+#' demographic_parity_ <-
+#'   fairness_metric(
+#'     .fn = detection_prevalence,
+#'     .name = "demographic_parity",
+#'     .post = diff_range
+#'   )
+#'
+#' m_set <- metric_set(demographic_parity_(Resample))
+#'
+#' m_set(hpc_cv, truth = obs, estimate = pred)
+#'
+#' # the `post` argument can be used to accommodate a wide
+#' # variety of parameterizations. to encode demographic
+#' # parity as a ratio inside of a difference, for example:
+#' ratio_range <- function(x, ...) {
+#'   range <- range(x$.estimate)
+#'   range[1] / range[2]
+#' }
+#'
+#' demographic_parity_ratio <-
+#'   fairness_metric(
+#'     .fn = detection_prevalence,
+#'     .name = "demographic_parity_ratio",
+#'     .post = ratio_range
+#'   )
+#'
+#' @export
+fairness_metric <- function(.fn, .name, .post) {
+  if (rlang::is_missing(.fn) || !inherits_any(.fn, c("metric", "metric_set"))) {
+    rlang::abort("`.fn` must be a metric function or metric set.")
+  }
+  if (rlang::is_missing(.name) || !is_string(.name)) {
+    abort("`.name` must be a string.")
+  }
+  if (rlang::is_missing(.post) || !is_function(.post)) {
+    abort("`.post` must be a function.")
+  }
+
+  function(by) {
+    by_str <- rlang::as_string(rlang::enexpr(by))
+    res <-
+      function(data, ...) {
+        gp_vars <- dplyr::group_vars(data)
+
+        res <- dplyr::group_by(data, {{by}}, .add = TRUE)
+        res <- .fn(res, ...)
+
+        if (length(gp_vars) > 0) {
+          splits <- vctrs::vec_split(res, res[gp_vars])
+          .estimate <- vapply(splits$val, .post, numeric(1), ...)
+        } else {
+          .estimate <- .post(res, ...)
+        }
+
+        if (!rlang::is_bare_numeric(.estimate)) {
+          abort(
+            "`.post` must return a single numeric value.",
+            call = rlang::call2("fairness_metric")
+          )
+        }
+
+        if (length(gp_vars) > 0) {
+          res <- dplyr::group_by(res, !!!dplyr::groups(data), .add = FALSE)
+        }
+
+        res <-
+          dplyr::summarize(
+            res,
+            .metric = .name,
+            !!".by" := by_str,
+            .estimator = .estimator[1],
+            .groups = "drop"
+          )
+
+        res$.estimate <- .estimate
+
+        res
+      }
+    res <- new_class_metric(res, direction = "minimize")
+    attr(res, "by") <- by_str
+    res
+  }
+}
+
+diff_range <- function(x, ...) {
+  diff(range(x$.estimate))
+}
+
+max_positive_rate_diff <- function(x, ...) {
+  metric_values <- vctrs::vec_split(x, x$.metric)
+
+  positive_rate_diff <- vapply(metric_values$val, diff_range, numeric(1), ...)
+
+  max(positive_rate_diff)
+}

R/fair-demographic_parity.R

@@ -0,0 +1,47 @@
+#' Demographic parity
+#'
+#' @description
+#' Demographic parity is satisfied when a model's predictions have the
+#' same predicted positive rate across groups. A value of 0 indicates parity
+#' across groups. Note that this definition does not depend on the true
+#' outcome; the `truth` argument is included in outputted metrics
+#' for consistency.
+#'
+#' Demographic parity is sometimes referred to as group fairness,
+#' disparate impact, or statistical parity.
+#'
+#' See the "Measuring Disparity" section for details on implementation.
+#'
+#' @param by The column identifier for the sensitive feature. This should be an
+#' unquoted column name referring to a column in the un-preprocessed data.
+#'
+#' @templateVar fn demographic_parity
+#' @templateVar internal_.fn detection_prevalence
+#' @templateVar internal_fn [detection_prevalence()]
+#' @template return-fair
+#' @template event-fair
+#' @template examples-fair
+#'
+#' @family fairness metrics
+#'
+#' @references
+#'
+#' Agarwal, A., Beygelzimer, A., Dudik, M., Langford, J., & Wallach, H. (2018).
+#' "A Reductions Approach to Fair Classification." Proceedings of the 35th
+#' International Conference on Machine Learning, in Proceedings of Machine
+#' Learning Research. 80:60-69.
+#'
+#' Verma, S., & Rubin, J. (2018). "Fairness definitions explained". In
+#' Proceedings of the international workshop on software fairness (pp. 1-7).
+#'
+#' Bird, S., Dudík, M., Edgar, R., Horn, B., Lutz, R., Milan, V., ... & Walker,
+#' K. (2020). "Fairlearn: A toolkit for assessing and improving fairness in AI".
+#' Microsoft, Tech. Rep. MSR-TR-2020-32.
+#'
+#' @export
+demographic_parity <-
+  fairness_metric(
+    .fn = detection_prevalence,
+    .name = "demographic_parity",
+    .post = diff_range
+  )

R/fair-equal_opportunity.R

@@ -0,0 +1,43 @@
+#' Equal opportunity
+#'
+#' @description
+#'
+#' Equal opportunity is satisfied when a model's predictions have the same
+#' true positive and false negative rates across protected groups. A value of
+#' 0 indicates parity across groups.
+#'
+#' Equal opportunity is sometimes referred to as conditional procedure accuracy
+#' equality or disparate mistreatment.
+#'
+#' See the "Measuring Disparity" section for details on implementation.
+#'
+#' @inheritParams demographic_parity
+#'
+#' @templateVar fn equal_opportunity
+#' @templateVar internal_.fn sens
+#' @templateVar internal_fn [sens()]
+#' @template return-fair
+#' @template event-fair
+#' @template examples-fair
+#'
+#' @family fairness metrics
+#'
+#' @references
+#'
+#' Hardt, M., Price, E., & Srebro, N. (2016). "Equality of opportunity in
+#' supervised learning". Advances in neural information processing systems, 29.
+#'
+#' Verma, S., & Rubin, J. (2018). "Fairness definitions explained". In
+#' Proceedings of the international workshop on software fairness (pp. 1-7).
+#'
+#' Bird, S., Dudík, M., Edgar, R., Horn, B., Lutz, R., Milan, V., ... & Walker,
+#' K. (2020). "Fairlearn: A toolkit for assessing and improving fairness in AI".
+#' Microsoft, Tech. Rep. MSR-TR-2020-32.
+#'
+#' @export
+equal_opportunity <-
+  fairness_metric(
+    .fn = sens,
+    .name = "equal_opportunity",
+    .post = diff_range
+  )

R/fair-equalized_odds.R

@@ -0,0 +1,70 @@
+#' Equalized odds
+#'
+#' @description
+#'
+#' Equalized odds is satisfied when a model's predictions have the same false
+#' positive, true positive, false negative, and true negative rates across
+#' protected groups. A value of 0 indicates parity across groups.
+#'
+#' Equalized odds is sometimes referred to as conditional procedure accuracy
+#' equality or disparate mistreatment.
+#'
+#' See the "Measuring disparity" section for details on implementation.
+#'
+#' @inheritParams demographic_parity
+#'
+#' @templateVar fn equalized_odds
+#' @templateVar internal_fn [sens()] and [spec()]
+#' @template return-fair
+#' @template examples-fair
+#'
+#' @section Measuring Disparity:
+#' By default, this function takes the maximum difference in range of [sens()]
+#' and [spec()] `.estimate`s across groups. That is, the maximum pair-wise
+#' disparity in [sens()] or [spec()] between groups is the return value of
+#' `equalized_odds()`'s `.estimate`.
+#'
+#' For finer control of group treatment, construct a context-aware fairness
+#' metric with the [fairness_metric()] function by passing a custom `.post`
+#' function:
+#'
+#' ```
+#' # see yardstick:::max_positive_rate_diff for the actual `.post()`
+#' diff_range <- function(x, ...) {diff(range(x$.estimate))}
+#'
+#' equalized_odds_2 <-
+#'   fairness_metric(
+#'     .fn = metric_set(sens, spec),
+#'     .name = "equalized_odds_2",
+#'     .post = diff_range
+#'   )
+#' ```
+#'
+#' In `.post()`, `x` is the [metric_set()] output with [sens()] and [spec()]
+#' values for each group, and `...` gives additional arguments (such as a grouping
+#' level to refer to as the "baseline") to pass to the function outputted
+#' by `equalized_odds_2()` for context.
+#'
+#' @family fairness metrics
+#'
+#' @references
+#'
+#' Agarwal, A., Beygelzimer, A., Dudik, M., Langford, J., & Wallach, H. (2018).
+#' "A Reductions Approach to Fair Classification." Proceedings of the 35th
+#' International Conference on Machine Learning, in Proceedings of Machine
+#' Learning Research. 80:60-69.
+#'
+#' Verma, S., & Rubin, J. (2018). "Fairness definitions explained". In
+#' Proceedings of the international workshop on software fairness (pp. 1-7).
+#'
+#' Bird, S., Dudík, M., Edgar, R., Horn, B., Lutz, R., Milan, V., ... & Walker,
+#' K. (2020). "Fairlearn: A toolkit for assessing and improving fairness in AI".
+#' Microsoft, Tech. Rep. MSR-TR-2020-32.
+#'
+#' @export
+equalized_odds <-
+  fairness_metric(
+    .fn = metric_set(sens, spec),
+    .name = "equalized_odds",
+    .post = max_positive_rate_diff
+  )

_pkgdown.yml

@@ -68,6 +68,13 @@ reference:
     - iic
     - poisson_log_loss
 
+  - title: Fairness Metrics
+    contents:
+    - fairness_metric
+    - demographic_parity
+    - equalized_odds
+    - equal_opportunity
+
   - title: Curve Functions
     contents:
     - roc_curve

man-roxygen/event-fair.R

@@ -0,0 +1,25 @@
+#' @section Measuring Disparity:
+#' By default, this function takes the difference in range of <%=internal_fn %>
+#' `.estimate`s across groups. That is, the maximum pair-wise disparity between
+#' groups is the return value of `<%=fn %>()`'s `.estimate`.
+#'
+#' For finer control of group treatment, construct a context-aware fairness
+#' metric with the [fairness_metric()] function by passing a custom `.post`
+#' function:
+#'
+#' ```
+#' # the actual default `.post` is:
+#' diff_range <- function(x, ...) {diff(range(x$.estimate))}
+#'
+#' <%=fn %>_2 <-
+#'   fairness_metric(
+#'     .fn = <%=internal_.fn %>,
+#'     .name = "<%=fn %>_2",
+#'     .post = diff_range
+#'   )
+#' ```
+#'
+#' In `.post()`, `x` is the `metric_set()` output with <%=internal_fn %> values
+#' for each group, and `...` gives additional arguments (such as a grouping
+#' level to refer to as the "baseline") to pass to the function outputted
+#' by `<%=fn %>_2()` for context.

man-roxygen/examples-fair.R

@@ -0,0 +1,19 @@
+#' @examples
+#' library(dplyr)
+#'
+#' data(hpc_cv)
+#'
+#' head(hpc_cv)
+#'
+#' # evaluate `<%=fn %>()` by Resample
+#' m_set <- metric_set(<%=fn %>(Resample))
+#'
+#' # use output like any other metric set
+#' hpc_cv %>%
+#'   m_set(truth = obs, estimate = pred)
+#'
+#' # can mix fairness metrics and regular metrics
+#' m_set_2 <- metric_set(sens, <%=fn %>(Resample))
+#'
+#' hpc_cv %>%
+#'   m_set_2(truth = obs, estimate = pred)