Nothing
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = FALSE,
comment = "#>",
warning = FALSE,
message = FALSE,
cache = FALSE,
fig.align = 'center',
dpi = 72,
fig.width = 10,
fig.height = 7
)
## -----------------------------------------------------------------------------
library(fairmodels)
data("compas")
head(compas)
## -----------------------------------------------------------------------------
compas$Two_yr_Recidivism <- as.factor(ifelse(compas$Two_yr_Recidivism == '1', '0', '1'))
## -----------------------------------------------------------------------------
library(DALEX)
library(ranger)
# train
rf_compas <- ranger(Two_yr_Recidivism ~., data = compas, probability = TRUE)
# numeric target values
y_numeric <- as.numeric(compas$Two_yr_Recidivism)-1
# explainer
rf_explainer <- explain(rf_compas, data = compas[,-1], y = y_numeric, colorize = FALSE)
## -----------------------------------------------------------------------------
fobject <- fairness_check(rf_explainer, # explainer
protected = compas$Ethnicity, # protected variable as factor
privileged = "Caucasian", # level in protected variable, potentially more privileged
cutoff = 0.5, # cutoff - optional, default = 0.5
colorize = FALSE)
## -----------------------------------------------------------------------------
print(fobject, colorize = FALSE)
## -----------------------------------------------------------------------------
plot(fobject)
## -----------------------------------------------------------------------------
plot_density(fobject)
## -----------------------------------------------------------------------------
plot(metric_scores(fobject))
## ---- results= "hide"---------------------------------------------------------
library(gbm)
rf_compas_1 <- ranger(Two_yr_Recidivism ~Number_of_Priors+Age_Below_TwentyFive,
data = compas,
probability = TRUE)
lr_compas_1 <- glm(Two_yr_Recidivism~.,
data=compas,
family=binomial(link="logit"))
rf_compas_2 <- ranger(Two_yr_Recidivism ~., data = compas, probability = TRUE)
rf_compas_3 <- ranger(Two_yr_Recidivism ~ Age_Above_FourtyFive+Misdemeanor,
data = compas,
probability = TRUE)
df <- compas
df$Two_yr_Recidivism <- as.numeric(compas$Two_yr_Recidivism)-1
gbm_compas_1<- gbm(Two_yr_Recidivism~., data = df)
explainer_1 <- explain(rf_compas_1, data = compas[,-1], y = y_numeric)
explainer_2 <- explain(lr_compas_1, data = compas[,-1], y = y_numeric)
explainer_3 <- explain(rf_compas_2, data = compas[,-1], y = y_numeric, label = "ranger_2")
explainer_4 <- explain(rf_compas_3, data = compas[,-1], y = y_numeric, label = "ranger_3")
explainer_5 <- explain(gbm_compas_1, data = compas[,-1], y = y_numeric)
## -----------------------------------------------------------------------------
fobject <- fairness_check(explainer_1, explainer_2,
explainer_3, explainer_4,
explainer_5,
protected = compas$Ethnicity,
privileged = "Caucasian",
verbose = FALSE)
## -----------------------------------------------------------------------------
fobject$parity_loss_metric_data
## -----------------------------------------------------------------------------
# for the first model
fobject$groups_data$ranger$TPR
## -----------------------------------------------------------------------------
# for first model
fobject$cutoff$ranger
## -----------------------------------------------------------------------------
sm <- stack_metrics(fobject)
plot(sm)
## -----------------------------------------------------------------------------
cm <- choose_metric(fobject, "TPR")
plot(cm)
## -----------------------------------------------------------------------------
fair_pca <- fairness_pca(fobject)
print(fair_pca)
## -----------------------------------------------------------------------------
plot(fair_pca)
## -----------------------------------------------------------------------------
fheatmap <- fairness_heatmap(fobject)
plot(fheatmap, text_size = 3)
## -----------------------------------------------------------------------------
fap <- performance_and_fairness(fobject, fairness_metric = "STP")
plot(fap)
## -----------------------------------------------------------------------------
fobject2 <- fairness_check(explainer_1,explainer_2,
protected = compas$Ethnicity,
privileged = "Caucasian",
verbose = FALSE)
gm <- group_metric(fobject2, fairness_metric = "FPR")
plot(gm)
## -----------------------------------------------------------------------------
fradar <- fairness_radar(fobject2)
plot(fradar)
## -----------------------------------------------------------------------------
ac <- all_cutoffs(fobject2)
plot(ac)
## -----------------------------------------------------------------------------
cpc <- ceteris_paribus_cutoff(fobject2, subgroup = "African_American")
plot(cpc)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.