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,
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,
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,
num.trees = 50,
num.threads = 1,
seed = 123
)
explainer_rf_p <- DALEX::explain(rf_p,
data = data[, -1], y = y_numeric,
label = "sampled_preferential"
)
fobject <- fairness_check(explainer_rf, explainer_rf_u, explainer_rf_p,
protected = data$Age,
privileged = "old"
)
fobject
plot(fobject)
# }
Run the code above in your browser using DataLab