diff --git a/DESCRIPTION b/DESCRIPTION index e50ed9c..d5baef6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: fairmodels Type: Package Title: Flexible Tool for Bias Detection, Visualization, and Mitigation -Version: 1.0.0 +Version: 1.0.1 Authors@R: c(person("Jakub", "Wiśniewski", role = c("aut", "cre"), email = "jakwisn@gmail.com"), diff --git a/NEWS.md b/NEWS.md index bd6b4e0..bbb1187 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# fairmodels 1.0.1 +* Changed examples - added parameter `num.threads = 1` to `ranger` and added *donttest{}* to examples with long computation time. + # fairmodels 1.0.0 * Added citation information * Added additional reference in `fairness_check()` documentation. diff --git a/R/all_cutoffs.R b/R/all_cutoffs.R index a2737bf..185b67d 100644 --- a/R/all_cutoffs.R +++ b/R/all_cutoffs.R @@ -19,22 +19,32 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' ac <- all_cutoffs(fobject) +#' plot(ac) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 100, +#' seed = 1) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -#' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' explainer_rf <- DALEX::explain(rf_model, +#' data = german[,-1], +#' y = y_numeric) #' +#' fobject <- fairness_check(explainer_rf, fobject) #' #' ac <- all_cutoffs(fobject) #' plot(ac) -#' +#' } all_cutoffs <- function(x, grid_points = 101, diff --git a/R/ceteris_paribus_cutoff.R b/R/ceteris_paribus_cutoff.R index 4ebe3ef..9d74a27 100644 --- a/R/ceteris_paribus_cutoff.R +++ b/R/ceteris_paribus_cutoff.R @@ -26,16 +26,26 @@ #' y_numeric <- as.numeric(two_yr_recidivism) -1 #' compas$Two_yr_Recidivism <- two_yr_recidivism #' +#' #' lm_model <- glm(Two_yr_Recidivism~., #' data=compas, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = compas$Ethnicity, +#' privileged = "Caucasian") +#' +#' cpc <- ceteris_paribus_cutoff(fobject, "African_American") +#' plot(cpc) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Two_yr_Recidivism ~., #' data = compas, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = compas[,-1], y = y_numeric) #' #' fobject <- fairness_check(explainer_lm, explainer_rf, @@ -43,9 +53,8 @@ #' privileged = "Caucasian") #' #' cpc <- ceteris_paribus_cutoff(fobject, "African_American") -#' #' plot(cpc) -#' +#' } ceteris_paribus_cutoff <- function(x, subgroup, diff --git a/R/choose_metric.R b/R/choose_metric.R index 3a89707..4b4616d 100644 --- a/R/choose_metric.R +++ b/R/choose_metric.R @@ -41,21 +41,32 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' +#' cm <- choose_metric(fobject, "TPR") +#' plot(cm) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' cm <- choose_metric(fobject, "TPR") #' plot(cm) #' +#' } +#' choose_metric <- function(x, fairness_metric = "FPR"){ diff --git a/R/expand_fairness_object.R b/R/expand_fairness_object.R index 04b69fd..5a2ebd8 100644 --- a/R/expand_fairness_object.R +++ b/R/expand_fairness_object.R @@ -22,20 +22,27 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' expand_fairness_object(fobject, drop_metrics_with_na = TRUE) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' expand_fairness_object(fobject, drop_metrics_with_na = TRUE) #' +#' } expand_fairness_object <- function(x, scale = FALSE, drop_metrics_with_na = FALSE, fairness_metrics = NULL){ diff --git a/R/fairness_check.R b/R/fairness_check.R index d6ac864..ffc3b34 100644 --- a/R/fairness_check.R +++ b/R/fairness_check.R @@ -92,6 +92,14 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' plot(fobject) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, @@ -99,18 +107,15 @@ #' num.trees = 100, #' seed = 1) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' #' explainer_rf <- DALEX::explain(rf_model, #' data = german[,-1], #' y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' plot(fobject) -#' +#'} fairness_check <- function(x, diff --git a/R/fairness_heatmap.R b/R/fairness_heatmap.R index 860da29..e0bebbc 100644 --- a/R/fairness_heatmap.R +++ b/R/fairness_heatmap.R @@ -32,7 +32,8 @@ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/R/fairness_pca.R b/R/fairness_pca.R index 086087b..10dd6c1 100644 --- a/R/fairness_pca.R +++ b/R/fairness_pca.R @@ -29,7 +29,8 @@ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/R/fairness_radar.R b/R/fairness_radar.R index d816be3..07ddfd3 100644 --- a/R/fairness_radar.R +++ b/R/fairness_radar.R @@ -22,17 +22,29 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", +#' "TPR", "PPV")) +#' +#' plot(fradar) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) +#' #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' #' fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", @@ -42,6 +54,7 @@ #' "PPV")) #' #' plot(fradar) +#' } fairness_radar <- function(x, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')){ diff --git a/R/group_metric.R b/R/group_metric.R index 2bc2d6c..c9f70c6 100644 --- a/R/group_metric.R +++ b/R/group_metric.R @@ -52,22 +52,33 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) +#' plot(gm) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) #' #' plot(gm) #' +#'} +#' #' @return \code{group_metric} object. #' It is a list with following items: #' \itemize{ diff --git a/R/metric_scores.R b/R/metric_scores.R index 1cc2dea..fa710ec 100644 --- a/R/metric_scores.R +++ b/R/metric_scores.R @@ -25,21 +25,32 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) +#' plot(ms) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) #' plot(ms) #' +#' } +#' diff --git a/R/performance_and_fairness.R b/R/performance_and_fairness.R index 81ed017..b15eeeb 100644 --- a/R/performance_and_fairness.R +++ b/R/performance_and_fairness.R @@ -32,17 +32,26 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' paf <- performance_and_fairness(fobject) +#' plot(paf) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' # same explainers with different cutoffs for female #' fobject <- fairness_check(explainer_lm, explainer_rf, fobject, @@ -55,6 +64,7 @@ #' #' plot(paf) #' +#'} diff --git a/R/plot_all_cutoffs.R b/R/plot_all_cutoffs.R index 2f51977..d136c66 100644 --- a/R/plot_all_cutoffs.R +++ b/R/plot_all_cutoffs.R @@ -25,24 +25,32 @@ #' data = german, #' family=binomial(link="logit")) #' -#' rf_model <- ranger::ranger(Risk ~., -#' data = german, -#' probability = TRUE, -#' num.trees = 200) -#' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -#' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, +#' fobject <- fairness_check(explainer_lm, #' protected = german$Sex, #' privileged = "male") #' -#' ac <- all_cutoffs(fobject, -#' fairness_metrics = c("TPR", -#' "FPR")) +#' ac <- all_cutoffs(fobject) #' plot(ac) #' +#' \donttest{ +#' rf_model <- ranger::ranger(Risk ~., +#' data = german, +#' probability = TRUE, +#' num.trees = 100, +#' seed = 1) +#' +#' +#' explainer_rf <- DALEX::explain(rf_model, +#' data = german[,-1], +#' y = y_numeric) #' +#' fobject <- fairness_check(explainer_rf, fobject) +#' +#' ac <- all_cutoffs(fobject) +#' plot(ac) +#' } plot.all_cutoffs <- function(x, ..., label = NULL){ diff --git a/R/plot_ceteris_paribus_cutoff.R b/R/plot_ceteris_paribus_cutoff.R index dadaf02..b328f1f 100644 --- a/R/plot_ceteris_paribus_cutoff.R +++ b/R/plot_ceteris_paribus_cutoff.R @@ -17,31 +17,42 @@ #' #' @examples #' -#' data("german") +#' data("compas") #' -#' y_numeric <- as.numeric(german$Risk) -1 +#' # positive outcome - not being recidivist +#' two_yr_recidivism <- factor(compas$Two_yr_Recidivism, levels = c(1,0)) +#' y_numeric <- as.numeric(two_yr_recidivism) -1 +#' compas$Two_yr_Recidivism <- two_yr_recidivism #' -#' lm_model <- glm(Risk~., -#' data = german, +#' +#' lm_model <- glm(Two_yr_Recidivism~., +#' data=compas, #' family=binomial(link="logit")) #' -#' rf_model <- ranger::ranger(Risk ~., -#' data = german, +#' explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = compas$Ethnicity, +#' privileged = "Caucasian") +#' +#' cpc <- ceteris_paribus_cutoff(fobject, "African_American") +#' plot(cpc) +#' +#' \donttest{ +#' rf_model <- ranger::ranger(Two_yr_Recidivism ~., +#' data = compas, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -#' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) +#' explainer_rf <- DALEX::explain(rf_model, data = compas[,-1], y = y_numeric) #' #' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") -#' -#' cpc <- ceteris_paribus_cutoff(fobject, "female") -#' plot(cpc) +#' protected = compas$Ethnicity, +#' privileged = "Caucasian") #' -#' cpc <- ceteris_paribus_cutoff(fobject, "female", cumulated = TRUE) +#' cpc <- ceteris_paribus_cutoff(fobject, "African_American") #' plot(cpc) +#' } #' diff --git a/R/plot_chosen_metric.R b/R/plot_chosen_metric.R index d8c8799..d4291a8 100644 --- a/R/plot_chosen_metric.R +++ b/R/plot_chosen_metric.R @@ -22,20 +22,31 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' +#' cm <- choose_metric(fobject, "TPR") +#' plot(cm) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' cm <- choose_metric(fobject, "TPR") #' plot(cm) +#' +#' } plot.chosen_metric <- function(x, ...){ diff --git a/R/plot_fairness_heatmap.R b/R/plot_fairness_heatmap.R index 07e4f79..90524e2 100644 --- a/R/plot_fairness_heatmap.R +++ b/R/plot_fairness_heatmap.R @@ -39,7 +39,9 @@ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1, +#' seed = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/R/plot_fairness_object.R b/R/plot_fairness_object.R index 9a08991..05b145e 100644 --- a/R/plot_fairness_object.R +++ b/R/plot_fairness_object.R @@ -24,6 +24,14 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' plot(fobject) +#' +#' \donttest{ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, @@ -31,17 +39,15 @@ #' num.trees = 100, #' seed = 1) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' #' explainer_rf <- DALEX::explain(rf_model, #' data = german[,-1], #' y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' plot(fobject) +#'} #' plot.fairness_object <- function(x, ...){ diff --git a/R/plot_fairness_pca.R b/R/plot_fairness_pca.R index 6dda7bd..c4ebcbf 100644 --- a/R/plot_fairness_pca.R +++ b/R/plot_fairness_pca.R @@ -29,7 +29,8 @@ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/R/plot_fairness_radar.R b/R/plot_fairness_radar.R index 9694d6d..a70599c 100644 --- a/R/plot_fairness_radar.R +++ b/R/plot_fairness_radar.R @@ -22,22 +22,36 @@ #' data = german, #' family=binomial(link="logit")) #' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", +#' "TPR", "PPV")) +#' +#' plot(fradar) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) +#' #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' -#' fradar <- fairness_radar(fobject) +#' fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", +#' "TPR", "PPV")) #' #' plot(fradar) +#' } #' plot.fairness_radar <- function(x, ...) { diff --git a/R/plot_group_metric.R b/R/plot_group_metric.R index 276fc44..1868f38 100644 --- a/R/plot_group_metric.R +++ b/R/plot_group_metric.R @@ -25,22 +25,33 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) +#' plot(gm) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' -#' gm <- group_metric(fobject) +#' gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) #' #' plot(gm) #' +#'} +#' #' diff --git a/R/plot_metric_scores.R b/R/plot_metric_scores.R index f170dfa..968007b 100644 --- a/R/plot_metric_scores.R +++ b/R/plot_metric_scores.R @@ -16,21 +16,31 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) +#' plot(ms) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' -#' ms <- metric_scores(fobject, fairness_metrics = c("TPR","STP","ACC")) +#' ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) #' plot(ms) #' +#' } plot.metric_scores <- function(x, ...){ diff --git a/R/plot_performance_and_fairness.R b/R/plot_performance_and_fairness.R index 197e9c4..867981e 100644 --- a/R/plot_performance_and_fairness.R +++ b/R/plot_performance_and_fairness.R @@ -24,17 +24,26 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' paf <- performance_and_fairness(fobject) +#' plot(paf) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' # same explainers with different cutoffs for female #' fobject <- fairness_check(explainer_lm, explainer_rf, fobject, @@ -46,6 +55,8 @@ #' paf <- performance_and_fairness(fobject) #' #' plot(paf) +#' +#'} plot.performance_and_fairness <- function(x , ...){ diff --git a/R/plot_stacked_metrics.R b/R/plot_stacked_metrics.R index 9f66c7c..09bbc74 100644 --- a/R/plot_stacked_metrics.R +++ b/R/plot_stacked_metrics.R @@ -18,20 +18,31 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' sm <- stack_metrics(fobject) +#' plot(sm) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' sm <- stack_metrics(fobject) #' plot(sm) +#' } + #' #' @export #' @rdname plot_stacked_metrics diff --git a/R/print.R b/R/print.R index 4606385..248a82c 100644 --- a/R/print.R +++ b/R/print.R @@ -23,7 +23,8 @@ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -83,7 +84,8 @@ print.all_cutoffs <- function(x, ..., label = NULL){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -135,7 +137,8 @@ print.ceteris_paribus_cutoff<- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -185,7 +188,8 @@ print.chosen_metric <- function(x,...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -253,7 +257,8 @@ print.fairness_heatmap <- function(x, ...) { #' probability = TRUE, #' max.depth = 3, #' num.trees = 100, -#' seed = 1) +#' seed = 1, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' @@ -347,7 +352,8 @@ print.fairness_object <- function(x, ..., colorize = TRUE){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -407,7 +413,8 @@ print.fairness_pca <- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -458,7 +465,8 @@ print.fairness_radar <- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -511,7 +519,8 @@ print.group_metric <- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -559,7 +568,8 @@ print.metric_scores <- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) @@ -624,7 +634,8 @@ print.performance_and_fairness <- function(x, ...){ #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, -#' num.trees = 200) +#' num.trees = 200, +#' num.threads = 1) #' #' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/R/resample.R b/R/resample.R index d7b6095..5ae82fc 100644 --- a/R/resample.R +++ b/R/resample.R @@ -18,20 +18,49 @@ #' #' @examples #' data("german") +#' #' data <- german +#' #' data$Age <- as.factor(ifelse(data$Age <= 25, "young", "old")) #' y_numeric <- as.numeric(data$Risk) -1 #' -#' rf <- ranger::ranger(Risk ~., data = data, probability = TRUE, seed = 123) +#' rf <- ranger::ranger(Risk ~., +#' data = data, +#' probability = TRUE, +#' num.trees = 50, +#' num.threads = 1, +#' seed = 123) #' #' u_indexes <- resample(data$Age, y = y_numeric) -#' rf_u <- ranger::ranger(Risk ~., data = data[u_indexes, ], probability = TRUE, seed = 123) #' -#' explainer_rf <- DALEX::explain(rf, data = data[, -1], y = y_numeric, label = "not_sampled") +#' rf_u <- ranger::ranger(Risk ~., +#' data = data[u_indexes, ], +#' probability = TRUE, +#' num.trees = 50, +#' num.threads = 1, +#' seed = 123) +#' +#' explainer_rf <- DALEX::explain(rf, +#' data = data[, -1], +#' y = y_numeric, +#' label = "not_sampled") +#' #' explainer_rf_u <- DALEX::explain(rf_u, data = data[, -1], y = y_numeric, label = "sampled_uniform") #' +#' fobject <- fairness_check(explainer_rf, explainer_rf_u, +#' protected = data$Age, +#' privileged = "old") +#' +#' fobject +#' plot(fobject) +#' +#' \donttest{ #' p_indexes <- resample(data$Age, y = y_numeric, type = "preferential", probs = explainer_rf$y_hat) -#' rf_p <- ranger::ranger(Risk ~., data = data[p_indexes, ], probability = TRUE, seed = 123) +#' rf_p <- ranger::ranger(Risk ~., data = data[p_indexes, ], +#' probability = TRUE, +#' num.trees = 50, +#' num.threads = 1, +#' seed = 123) #' #' explainer_rf_p <- DALEX::explain(rf_p, data = data[, -1], y = y_numeric, #' label = "sampled_preferential") @@ -42,6 +71,7 @@ #' #' fobject #' plot(fobject) +#' } resample <- function(protected, y, type = "uniform", probs = NULL, cutoff = 0.5){ diff --git a/R/stack_metrics.R b/R/stack_metrics.R index 90e1df1..d5b6982 100644 --- a/R/stack_metrics.R +++ b/R/stack_metrics.R @@ -24,20 +24,30 @@ #' data = german, #' family=binomial(link="logit")) #' +#' +#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) +#' +#' fobject <- fairness_check(explainer_lm, +#' protected = german$Sex, +#' privileged = "male") +#' +#' sm <- stack_metrics(fobject) +#' plot(sm) +#' +#' \donttest{ +#' #' rf_model <- ranger::ranger(Risk ~., #' data = german, #' probability = TRUE, #' num.trees = 200) #' -#' explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) #' explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) #' -#' fobject <- fairness_check(explainer_lm, explainer_rf, -#' protected = german$Sex, -#' privileged = "male") +#' fobject <- fairness_check(explainer_rf, fobject) #' #' sm <- stack_metrics(fobject) #' plot(sm) +#' } diff --git a/man/all_cutoffs.Rd b/man/all_cutoffs.Rd index 9082343..afd6f8e 100644 --- a/man/all_cutoffs.Rd +++ b/man/all_cutoffs.Rd @@ -33,20 +33,30 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +ac <- all_cutoffs(fobject) +plot(ac) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 100, + seed = 1) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +explainer_rf <- DALEX::explain(rf_model, + data = german[,-1], + y = y_numeric) +fobject <- fairness_check(explainer_rf, fobject) ac <- all_cutoffs(fobject) plot(ac) - +} } diff --git a/man/ceteris_paribus_cutoff.Rd b/man/ceteris_paribus_cutoff.Rd index 283b529..9090def 100644 --- a/man/ceteris_paribus_cutoff.Rd +++ b/man/ceteris_paribus_cutoff.Rd @@ -45,16 +45,26 @@ two_yr_recidivism <- factor(compas$Two_yr_Recidivism, levels = c(1,0)) y_numeric <- as.numeric(two_yr_recidivism) -1 compas$Two_yr_Recidivism <- two_yr_recidivism + lm_model <- glm(Two_yr_Recidivism~., data=compas, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = compas$Ethnicity, + privileged = "Caucasian") + +cpc <- ceteris_paribus_cutoff(fobject, "African_American") +plot(cpc) + +\donttest{ rf_model <- ranger::ranger(Two_yr_Recidivism ~., data = compas, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = compas[,-1], y = y_numeric) fobject <- fairness_check(explainer_lm, explainer_rf, @@ -62,7 +72,6 @@ fobject <- fairness_check(explainer_lm, explainer_rf, privileged = "Caucasian") cpc <- ceteris_paribus_cutoff(fobject, "African_American") - plot(cpc) - +} } diff --git a/man/choose_metric.Rd b/man/choose_metric.Rd index 435f6c1..2a90cde 100644 --- a/man/choose_metric.Rd +++ b/man/choose_metric.Rd @@ -49,19 +49,30 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + + +cm <- choose_metric(fobject, "TPR") +plot(cm) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) cm <- choose_metric(fobject, "TPR") plot(cm) } + +} diff --git a/man/expand_fairness_object.Rd b/man/expand_fairness_object.Rd index 8a75e8d..2f2d93a 100644 --- a/man/expand_fairness_object.Rd +++ b/man/expand_fairness_object.Rd @@ -36,18 +36,25 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") +expand_fairness_object(fobject, drop_metrics_with_na = TRUE) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) expand_fairness_object(fobject, drop_metrics_with_na = TRUE) } +} diff --git a/man/fairness_check.Rd b/man/fairness_check.Rd index 68da0b2..29d4975 100644 --- a/man/fairness_check.Rd +++ b/man/fairness_check.Rd @@ -106,6 +106,14 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") +plot(fobject) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, @@ -113,18 +121,15 @@ rf_model <- ranger::ranger(Risk ~., num.trees = 100, seed = 1) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) plot(fobject) - +} } \references{ Zafar,Valera, Rodriguez, Gummadi (2017) \url{https://arxiv.org/pdf/1610.08452.pdf} diff --git a/man/fairness_heatmap.Rd b/man/fairness_heatmap.Rd index 42ea958..af94c0e 100644 --- a/man/fairness_heatmap.Rd +++ b/man/fairness_heatmap.Rd @@ -40,7 +40,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/fairness_pca.Rd b/man/fairness_pca.Rd index 3398ee6..d01fa3b 100644 --- a/man/fairness_pca.Rd +++ b/man/fairness_pca.Rd @@ -39,7 +39,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/fairness_radar.Rd b/man/fairness_radar.Rd index c8f0223..57536bd 100644 --- a/man/fairness_radar.Rd +++ b/man/fairness_radar.Rd @@ -31,17 +31,29 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", + "TPR", "PPV")) + +plot(fradar) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) + -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", @@ -52,3 +64,4 @@ fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", plot(fradar) } +} diff --git a/man/group_metric.Rd b/man/group_metric.Rd index 8a37790..a51cf38 100644 --- a/man/group_metric.Rd +++ b/man/group_metric.Rd @@ -78,20 +78,31 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) +plot(gm) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) plot(gm) } + +} diff --git a/man/metric_scores.Rd b/man/metric_scores.Rd index 291c9f0..6b7b54f 100644 --- a/man/metric_scores.Rd +++ b/man/metric_scores.Rd @@ -34,19 +34,30 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) +plot(ms) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) plot(ms) } + +} diff --git a/man/performance_and_fairness.Rd b/man/performance_and_fairness.Rd index dbc9754..4a3ddce 100644 --- a/man/performance_and_fairness.Rd +++ b/man/performance_and_fairness.Rd @@ -40,17 +40,26 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +paf <- performance_and_fairness(fobject) +plot(paf) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) # same explainers with different cutoffs for female fobject <- fairness_check(explainer_lm, explainer_rf, fobject, @@ -64,3 +73,4 @@ paf <- performance_and_fairness(fobject) plot(paf) } +} diff --git a/man/plot_all_cutoffs.Rd b/man/plot_all_cutoffs.Rd index e23ab5e..97f7c87 100644 --- a/man/plot_all_cutoffs.Rd +++ b/man/plot_all_cutoffs.Rd @@ -30,22 +30,30 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) -rf_model <- ranger::ranger(Risk ~., - data = german, - probability = TRUE, - num.trees = 200) - explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, +fobject <- fairness_check(explainer_lm, protected = german$Sex, privileged = "male") -ac <- all_cutoffs(fobject, - fairness_metrics = c("TPR", - "FPR")) +ac <- all_cutoffs(fobject) plot(ac) +\donttest{ +rf_model <- ranger::ranger(Risk ~., + data = german, + probability = TRUE, + num.trees = 100, + seed = 1) + + +explainer_rf <- DALEX::explain(rf_model, + data = german[,-1], + y = y_numeric) +fobject <- fairness_check(explainer_rf, fobject) + +ac <- all_cutoffs(fobject) +plot(ac) +} } diff --git a/man/plot_ceteris_paribus_cutoff.Rd b/man/plot_ceteris_paribus_cutoff.Rd index 4086839..918e7e9 100644 --- a/man/plot_ceteris_paribus_cutoff.Rd +++ b/man/plot_ceteris_paribus_cutoff.Rd @@ -21,30 +21,41 @@ it all in one plot. When default one is used all chosen metrics will be plotted } \examples{ -data("german") +data("compas") -y_numeric <- as.numeric(german$Risk) -1 +# positive outcome - not being recidivist +two_yr_recidivism <- factor(compas$Two_yr_Recidivism, levels = c(1,0)) +y_numeric <- as.numeric(two_yr_recidivism) -1 +compas$Two_yr_Recidivism <- two_yr_recidivism -lm_model <- glm(Risk~., - data = german, + +lm_model <- glm(Two_yr_Recidivism~., + data=compas, family=binomial(link="logit")) -rf_model <- ranger::ranger(Risk ~., - data = german, +explainer_lm <- DALEX::explain(lm_model, data = compas[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = compas$Ethnicity, + privileged = "Caucasian") + +cpc <- ceteris_paribus_cutoff(fobject, "African_American") +plot(cpc) + +\donttest{ +rf_model <- ranger::ranger(Two_yr_Recidivism ~., + data = compas, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) -explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) +explainer_rf <- DALEX::explain(rf_model, data = compas[,-1], y = y_numeric) fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") - -cpc <- ceteris_paribus_cutoff(fobject, "female") -plot(cpc) + protected = compas$Ethnicity, + privileged = "Caucasian") -cpc <- ceteris_paribus_cutoff(fobject, "female", cumulated = TRUE) +cpc <- ceteris_paribus_cutoff(fobject, "African_American") plot(cpc) +} } diff --git a/man/plot_chosen_metric.Rd b/man/plot_chosen_metric.Rd index 3571554..355f255 100644 --- a/man/plot_chosen_metric.Rd +++ b/man/plot_chosen_metric.Rd @@ -27,18 +27,29 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + + +cm <- choose_metric(fobject, "TPR") +plot(cm) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) cm <- choose_metric(fobject, "TPR") plot(cm) + +} } diff --git a/man/plot_fairness_heatmap.Rd b/man/plot_fairness_heatmap.Rd index acb0d31..98b27da 100644 --- a/man/plot_fairness_heatmap.Rd +++ b/man/plot_fairness_heatmap.Rd @@ -53,7 +53,9 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1, + seed = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/plot_fairness_object.Rd b/man/plot_fairness_object.Rd index b3b220e..1c8f41a 100644 --- a/man/plot_fairness_object.Rd +++ b/man/plot_fairness_object.Rd @@ -29,6 +29,14 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") +plot(fobject) + +\donttest{ rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, @@ -36,16 +44,14 @@ rf_model <- ranger::ranger(Risk ~., num.trees = 100, seed = 1) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) plot(fobject) +} } diff --git a/man/plot_fairness_pca.Rd b/man/plot_fairness_pca.Rd index 9602da3..80e301d 100644 --- a/man/plot_fairness_pca.Rd +++ b/man/plot_fairness_pca.Rd @@ -33,7 +33,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/plot_fairness_radar.Rd b/man/plot_fairness_radar.Rd index aa49eef..1121f5a 100644 --- a/man/plot_fairness_radar.Rd +++ b/man/plot_fairness_radar.Rd @@ -26,22 +26,36 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", + "TPR", "PPV")) + +plot(fradar) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) + -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) -fradar <- fairness_radar(fobject) +fradar <- fairness_radar(fobject, fairness_metrics = c("ACC", "STP", "TNR", + "TPR", "PPV")) plot(fradar) +} } \references{ diff --git a/man/plot_group_metric.Rd b/man/plot_group_metric.Rd index 770ba00..b58ba90 100644 --- a/man/plot_group_metric.Rd +++ b/man/plot_group_metric.Rd @@ -28,21 +28,32 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) +plot(gm) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) -gm <- group_metric(fobject) +gm <- group_metric(fobject, "TPR", "f1", parity_loss = TRUE) plot(gm) +} + } diff --git a/man/plot_metric_scores.Rd b/man/plot_metric_scores.Rd index 162d7de..0c80b4c 100644 --- a/man/plot_metric_scores.Rd +++ b/man/plot_metric_scores.Rd @@ -26,19 +26,29 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) +plot(ms) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) -ms <- metric_scores(fobject, fairness_metrics = c("TPR","STP","ACC")) +ms <- metric_scores(fobject, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'STP')) plot(ms) } +} diff --git a/man/plot_performance_and_fairness.Rd b/man/plot_performance_and_fairness.Rd index 5653562..c818410 100644 --- a/man/plot_performance_and_fairness.Rd +++ b/man/plot_performance_and_fairness.Rd @@ -27,17 +27,26 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +paf <- performance_and_fairness(fobject) +plot(paf) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) # same explainers with different cutoffs for female fobject <- fairness_check(explainer_lm, explainer_rf, fobject, @@ -49,4 +58,6 @@ fobject <- fairness_check(explainer_lm, explainer_rf, fobject, paf <- performance_and_fairness(fobject) plot(paf) + +} } diff --git a/man/plot_stacked_barplot.Rd b/man/plot_stacked_barplot.Rd index dcf9208..3cab07c 100644 --- a/man/plot_stacked_barplot.Rd +++ b/man/plot_stacked_barplot.Rd @@ -28,18 +28,28 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +sm <- stack_metrics(fobject) +plot(sm) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) sm <- stack_metrics(fobject) plot(sm) } +} diff --git a/man/plot_stacked_metrics.Rd b/man/plot_stacked_metrics.Rd index b88d60a..38ec914 100644 --- a/man/plot_stacked_metrics.Rd +++ b/man/plot_stacked_metrics.Rd @@ -28,19 +28,29 @@ lm_model <- glm(Risk~., data = german, family=binomial(link="logit")) + +explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) + +fobject <- fairness_check(explainer_lm, + protected = german$Sex, + privileged = "male") + +sm <- stack_metrics(fobject) +plot(sm) + +\donttest{ + rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, num.trees = 200) -explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) -fobject <- fairness_check(explainer_lm, explainer_rf, - protected = german$Sex, - privileged = "male") +fobject <- fairness_check(explainer_rf, fobject) sm <- stack_metrics(fobject) plot(sm) +} } diff --git a/man/print_all_cutoffs.Rd b/man/print_all_cutoffs.Rd index 73cee06..8cca4ca 100644 --- a/man/print_all_cutoffs.Rd +++ b/man/print_all_cutoffs.Rd @@ -29,7 +29,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_ceteris_paribus_cutoff.Rd b/man/print_ceteris_paribus_cutoff.Rd index cdcbc1c..8a75203 100644 --- a/man/print_ceteris_paribus_cutoff.Rd +++ b/man/print_ceteris_paribus_cutoff.Rd @@ -28,7 +28,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_chosen_metric.Rd b/man/print_chosen_metric.Rd index b32ece9..9e4e726 100644 --- a/man/print_chosen_metric.Rd +++ b/man/print_chosen_metric.Rd @@ -28,7 +28,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_fairness_heatmap.Rd b/man/print_fairness_heatmap.Rd index 6f81cbd..7ea3ac1 100644 --- a/man/print_fairness_heatmap.Rd +++ b/man/print_fairness_heatmap.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_fairness_object.Rd b/man/print_fairness_object.Rd index e08f319..dbe503e 100644 --- a/man/print_fairness_object.Rd +++ b/man/print_fairness_object.Rd @@ -31,7 +31,8 @@ rf_model <- ranger::ranger(Risk ~., probability = TRUE, max.depth = 3, num.trees = 100, - seed = 1) + seed = 1, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) diff --git a/man/print_fairness_pca.Rd b/man/print_fairness_pca.Rd index 7a77e85..5353a70 100644 --- a/man/print_fairness_pca.Rd +++ b/man/print_fairness_pca.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_fairness_radar.Rd b/man/print_fairness_radar.Rd index 070643f..9a220c0 100644 --- a/man/print_fairness_radar.Rd +++ b/man/print_fairness_radar.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_group_metric.Rd b/man/print_group_metric.Rd index 9088c69..c8c9ad6 100644 --- a/man/print_group_metric.Rd +++ b/man/print_group_metric.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_metric_scores.Rd b/man/print_metric_scores.Rd index d7e8f59..c200d8a 100644 --- a/man/print_metric_scores.Rd +++ b/man/print_metric_scores.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_performance_and_fairness.Rd b/man/print_performance_and_fairness.Rd index fb06d99..86d5274 100644 --- a/man/print_performance_and_fairness.Rd +++ b/man/print_performance_and_fairness.Rd @@ -27,7 +27,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/print_stacked_metrics.Rd b/man/print_stacked_metrics.Rd index 2585241..6ee34e8 100644 --- a/man/print_stacked_metrics.Rd +++ b/man/print_stacked_metrics.Rd @@ -28,7 +28,8 @@ lm_model <- glm(Risk~., rf_model <- ranger::ranger(Risk ~., data = german, probability = TRUE, - num.trees = 200) + num.trees = 200, + num.threads = 1) explainer_lm <- DALEX::explain(lm_model, data = german[,-1], y = y_numeric) explainer_rf <- DALEX::explain(rf_model, data = german[,-1], y = y_numeric) diff --git a/man/resample.Rd b/man/resample.Rd index 966176f..a34aac5 100644 --- a/man/resample.Rd +++ b/man/resample.Rd @@ -28,20 +28,49 @@ will sample observations close to border or far from border. } \examples{ data("german") + data <- german + data$Age <- as.factor(ifelse(data$Age <= 25, "young", "old")) y_numeric <- as.numeric(data$Risk) -1 -rf <- ranger::ranger(Risk ~., data = data, probability = TRUE, seed = 123) +rf <- ranger::ranger(Risk ~., + data = data, + probability = TRUE, + num.trees = 50, + num.threads = 1, + seed = 123) u_indexes <- resample(data$Age, y = y_numeric) -rf_u <- ranger::ranger(Risk ~., data = data[u_indexes, ], probability = TRUE, seed = 123) -explainer_rf <- DALEX::explain(rf, data = data[, -1], y = y_numeric, label = "not_sampled") +rf_u <- ranger::ranger(Risk ~., + data = data[u_indexes, ], + probability = TRUE, + num.trees = 50, + num.threads = 1, + seed = 123) + +explainer_rf <- DALEX::explain(rf, + data = data[, -1], + y = y_numeric, + label = "not_sampled") + explainer_rf_u <- DALEX::explain(rf_u, data = data[, -1], y = y_numeric, label = "sampled_uniform") +fobject <- fairness_check(explainer_rf, explainer_rf_u, + protected = data$Age, + privileged = "old") + +fobject +plot(fobject) + +\donttest{ p_indexes <- resample(data$Age, y = y_numeric, type = "preferential", probs = explainer_rf$y_hat) -rf_p <- ranger::ranger(Risk ~., data = data[p_indexes, ], probability = TRUE, seed = 123) +rf_p <- ranger::ranger(Risk ~., data = data[p_indexes, ], + probability = TRUE, + num.trees = 50, + num.threads = 1, + seed = 123) explainer_rf_p <- DALEX::explain(rf_p, data = data[, -1], y = y_numeric, label = "sampled_preferential") @@ -53,6 +82,7 @@ fobject <- fairness_check(explainer_rf, explainer_rf_u, explainer_rf_p, fobject plot(fobject) } +} \references{ This method was implemented based on Kamiran, Calders 2011 \url{https://link.springer.com/content/pdf/10.1007/s10115-011-0463-8.pdf} }