change examples for CRAN

ModelOriented · Apr 13, 2021 · bff06b6 · bff06b6
1 parent 084d8fe
commit bff06b6
Show file tree

Hide file tree

Showing 62 changed files with 713 additions and 239 deletions.
diff --git 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
@@ -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
@@ -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
@@ -26,26 +26,35 @@
 #' 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,
 #'                           protected = compas$Ethnicity,
 #'                           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
@@ -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
@@ -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
@@ -92,25 +92,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")
+#' plot(fobject)
+#'
+#' \donttest{
 #' rf_model <- ranger::ranger(Risk ~.,
 #'                            data = german,
 #'                            probability = TRUE,
 #'                            max.depth = 3,
 #'                            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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)
 #'
+#'}