bug fixes (#33)

* fixed (#32)

* changed ver number

* removed on-load message

DESCRIPTION

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

NEWS.md

@@ -1,3 +1,7 @@
+# fairmodels 0.2.4
+* Deleted on-load information message about four-fifths rule. 
+* Fixed bug with `NA` warning in metrics that are not chosen. (#32)
+
 # fairmodels 0.2.3
 * Fixed the way the `parity_loss` is calculated in `all_cutoffs` and `ceteris_paribus_cutoff`. (#24)
 * Updated vignettes

R/expand_fairness_object.R

@@ -4,7 +4,8 @@
 #'
 #' @param x object of class \code{fairness_object}
 #' @param drop_metrics_with_na logical, if \code{TRUE} metrics with NA will be omitted
-#' @param scale logical, if \code{TRUE} standarised.
+#' @param scale logical, if \code{TRUE} standardized.
+#' @param fairness_metrics character, vector of fairness metrics names indicating from which expand.
 #'
 #' @export
 #' @rdname expand_fairness_object
@@ -36,15 +37,20 @@
 #' expand_fairness_object(fobject, drop_metrics_with_na = TRUE)
 #'
 
-expand_fairness_object <- function(x, scale = FALSE, drop_metrics_with_na = FALSE){
+expand_fairness_object <- function(x, scale = FALSE, drop_metrics_with_na = FALSE, fairness_metrics = NULL){
+
 
   stopifnot(is.logical(scale))
   stopifnot(is.logical(drop_metrics_with_na))
   stopifnot(class(x) == "fairness_object")
 
-  n_exp          <- length(x$explainers)
+  n_exp                      <- length(x$explainers)
   parity_loss_metric_data    <- x$parity_loss_metric_data
-  labels         <- x$label
+  labels                     <- x$label
+
+  if (! is.null(fairness_metrics)){
+    parity_loss_metric_data <- parity_loss_metric_data[fairness_metrics]
+  }
 
   if (drop_metrics_with_na) {
     parity_loss_metric_data <- drop_metrics_with_na(parity_loss_metric_data)

R/fairness_radar.R

@@ -62,16 +62,15 @@ fairness_radar <- function(x, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', '
   if (any(is.na(data))){
     na_col_index      <- apply(data, 2, function(x) any(is.na(x)))
     cols_with_missing <- names(data)[na_col_index]
-    warning("Found metric with NA: ", paste(cols_with_missing, collapse = ", "), ", ommiting it")
 
-
-    fairness_metrics <- fairness_metrics[! fairness_metrics %in% cols_with_missing]
+    cols_with_missing <- cols_with_missing[cols_with_missing %in% fairness_metrics]
+    if (length(cols_with_missing) > 0){
+      warning("Found metric with NA: ", paste(cols_with_missing, collapse = ", "), ", ommiting it")
+      fairness_metrics <- fairness_metrics[! fairness_metrics %in% cols_with_missing]
+    }
   }
 
-  expanded_data <- expand_fairness_object(x)
-
-  # taking only some metrics
-  expanded_data <- expanded_data[expanded_data$metric %in% fairness_metrics,]
+  expanded_data <- expand_fairness_object(x, fairness_metrics = fairness_metrics)
 
 
   if (length(unique(expanded_data$metric)) <= 2) stop("metric data must have at least 3 columns without NA")

R/metric_scores.R

@@ -52,7 +52,9 @@ metric_scores <- function(x, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'S
   data <- data.frame()
   for (model in names(x$groups_data)){
     model_data_frame <- data.frame()
-    model_data           <- lapply(x$groups_data[[model]], function(x) data.frame(score = x, subgroup = names(x)))
+    model_data       <- lapply(x$groups_data[[model]],
+                               function(x) data.frame(score = x,
+                                                      subgroup = names(x)))
     for (i in seq_along(model_data)){
       model_data[[i]]$metric <- names(model_data)[i]
       model_data_frame <- rbind(model_data_frame, model_data[[i]])

R/stack_metrics.R

@@ -49,7 +49,9 @@ stack_metrics <- function(x, fairness_metrics = c('ACC', 'TPR', 'PPV', 'FPR', 'S
   if (! is.character(fairness_metrics) ) stop("metric argument must be character metric")
   sapply(fairness_metrics,assert_parity_metrics)
 
-  expanded_data <- expand_fairness_object(x,  drop_metrics_with_na = TRUE)
+  expanded_data <- expand_fairness_object(x,
+                                          drop_metrics_with_na = TRUE,
+                                          fairness_metrics = fairness_metrics)
 
   expanded_data           <- as.data.frame(expanded_data)
   colnames(expanded_data) <- c("metric","model","score")

tests/testthat/test_fairness_radar_and_plot.R

@@ -15,7 +15,7 @@ test_that("Test_fairness_radar_and_plot", {
 
   expect_error(fairness_radar(fobject, fairness_metrics = 1))
   fo <- fobject
-  fo$parity_loss_metric_data[2,2] <- NA
+  fo$parity_loss_metric_data[2,1] <- NA
 
   expect_warning(fairness_radar(fo))