fix #41 (#42)

Author: jakwisn

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: fairmodels
 Type: Package
 Title: Flexible Tool for Bias Detection, Visualization, and Mitigation
-Version: 1.1.0
+Version: 1.1.1
 Authors@R:
     c(person("Jakub", "Wiśniewski", role = c("aut", "cre"),
              email = "[email protected]"),

NEWS.md

@@ -1,3 +1,8 @@
+# fairmodels 1.1.1
+* Fixed error which appeared when 2 fairness objects had the same labels in them. Now if this appears it throws an error. [(#41)](https://github.com/ModelOriented/fairmodels/issues/41)
+* `privileged` parameter is now converted to character. [(#41)](https://github.com/ModelOriented/fairmodels/issues/41)
+* `reweight()` function now accepts factors [(#41)](https://github.com/ModelOriented/fairmodels/issues/41)
+
 # fairmodels 1.1.0
 * Added function `fairness_check_regression()` that supports regression models along with 2 plot types [(#38)](https://github.com/ModelOriented/fairmodels/issues/38).
 * Added additional tests. 

R/fairness_check.R

@@ -150,7 +150,7 @@ fairness_check <- function(x,
   fobjects_fcheck_data <- extract_data(fobjects, "fairness_check_data")
   fobjects_cf          <- extract_data(fobjects, "groups_confusion_matrices")
 
-  fobjects_label       <- sapply(fobjects, function(x) x$label)
+  fobjects_label       <- unlist(lapply(fobjects, function(x) x$label))
   fobjects_cuttofs     <- extract_data(fobjects, "cutoff")
   n_exp                <- length(explainers)
 

R/helper_functions.R

@@ -232,6 +232,7 @@ check_privileged <- function(privileged, fobjects, verbose) {
       } else {
         verbose_cat("character (", verbose = verbose)
         verbose_cat(color_codes$yellow_start, "changed from", class(privileged), color_codes$yellow_end, ")\n", verbose = verbose)
+        privileged <- as.character(privileged)
       }
     }
 
@@ -302,6 +303,7 @@ check_explainers <- function(all_explainers, protected, verbose){
     stop("All explainers must have same values of target variable")
   }
 
+
   if(! all(sapply(all_explainers, function(x) length(x$y) == length(protected)))) {
     verbose_cat("(", color_codes$red_start, "not compatible", color_codes$red_end, ")\n", verbose = verbose)
     stop("Lengths of protected variable and target variable in explainer differ")
@@ -325,6 +327,12 @@ check_labels <- function(label, explainers, fobjects_label){
         ( pass paramter \'label\' to fairness_check() or before to explain() function)")
   }
 
+  # fobjects must have unique labels
+  if (length(unique(fobjects_label)) != length(fobjects_label) ) {
+    stop("Fairness objects don't have unique labels
+        ( make sure that Fairness Objects will have unique labels of explainers before running fainress check")
+  }
+
   # labels must be unique for all explainers, those in fairness objects too
   if (any(label %in% fobjects_label)) {
     stop("Explainer has the same label as label in fairness_object")

R/reweight.R

@@ -46,6 +46,13 @@
 
 
 reweight <- function(protected, y){
+
+  if (! is.factor(protected)) {
+    cat("\nchanging protected to factor \n")
+    protected <- as.factor(protected)
+  }
+
+
   stopifnot(is.factor(protected))
   stopifnot(is.numeric(y))
   stopifnot(length(y) == length(protected))

tests/testthat/test_fairness_check.R

@@ -34,6 +34,19 @@ test_that("Test fairness_check", {
                               cutoff = 0.5,
                               colorize = FALSE))
 
+  expect_equal(fairness_check(explainer_glm, explainer_rf,
+                              protected = as.numeric(compas$Sex)-1,
+                              privileged = 0,
+                              cutoff = 0.5,
+                              verbose = FALSE),
+               fairness_check(explainer_glm, explainer_rf,
+                              protected = as.numeric(compas$Sex)-1,
+                              privileged = "0",
+                              cutoff = 0.5,
+                              colorize = FALSE))
+
+
+
   # errors
 
   expect_error(fairness_check(explainer_glm, explainer_rf,
@@ -69,11 +82,15 @@ test_that("Test fairness_check", {
                               cutoff = list(female = 0.5),
                               epsilon = c(0.3, 0.5)))
 
+  fobject2 <- fobject
+  expect_error(fairness_check(fobject, fobject2))
+
+
   exp2 <- explainer_glm
   exp2$model_info$type <- 'regression'
   expect_error(fairness_check(exp2, fobject))
 
-  fobject2 <- fobject
+
   fobject2$protected <- compas$Sex[1:6000]
   suppressWarnings( expect_error(fairness_check(fobject, fobject2)))
   suppressWarnings( expect_error(fairness_check(fobject, fobject2, privileged = "Female")))

tests/testthat/test_reweight.R

@@ -9,9 +9,14 @@ expect_equal(round(predicted_weights,2), actual_weights)
 y_numeric <- as.numeric(compas$Two_yr_Recidivism)-1
 
 # numeric protected
-expect_error(reweight(compas$Number_of_Priors, y_numeric))
-# non numeric y
-expect_error(reweight(compas$Sex, compas$Two_yr_Recidivism))
+
+expect_equal(reweight(compas$Sex, y_numeric),
+             reweight(as.factor(compas$Sex), y_numeric))
+
+expect_equal(reweight(compas$Sex, y_numeric),
+             reweight(as.numeric(compas$Sex), y_numeric))
+
+
 # difference in length
 expect_error(reweight(compas$Sex[,-1], y_numeric))
 # y must be 0 and 1