feat: add boruta filter

DESCRIPTION

@@ -31,6 +31,7 @@ Imports:
     paradox,
     R6
 Suggests:
+    Boruta,
     care,
     caret,
     carSurv,
@@ -55,6 +56,7 @@ Collate:
     'mlr_filters.R'
     'FilterAUC.R'
     'FilterAnova.R'
+    'FilterBoruta.R'
     'FilterCMIM.R'
     'FilterCarScore.R'
     'FilterCarSurvScore.R'

NAMESPACE

@@ -5,6 +5,7 @@ S3method(as.data.table,Filter)
 export(Filter)
 export(FilterAUC)
 export(FilterAnova)
+export(FilterBoruta)
 export(FilterCMIM)
 export(FilterCarScore)
 export(FilterCarSurvScore)

R/FilterBoruta.R

@@ -0,0 +1,89 @@
+#' @title Burota Filter
+#'
+#' @name mlr_filters_boruta
+#'
+#' @description
+#' Filter using the Boruta algorithm for feature selection.
+#' If `keep = "tentative"`, confirmed and tentative features are returned.
+#' Note that there is no ordering in the selected features.
+#' Selected features get a score of 1, deselected features get a score of 0.
+#' The order of selected features is random.
+#' In combination with \CRANpkg{mlr3pipelines}, only the filter criterion `cutoff` makes sense.
+#'
+#' @references
+#' `r format_bib("kursa_2010")`
+#'
+#' @family Filter
+#' @include Filter.R
+#' @template seealso_filter
+#' @export
+#' @examples
+#' \donttest{
+#'   if (requireNamespace("Boruta")) {
+#'    task = mlr3::tsk("sonar")
+#'    filter = flt("boruta")
+#'    filter$calculate(task)
+#'    as.data.table(filter)
+#'   }
+#' }
+
+FilterBoruta = R6Class("FilterBoruta",
+  inherit = Filter,
+
+  public = list(
+
+    #' @description
+    #' Creates a new instance of this [R6][R6::R6Class] class.
+    initialize = function() {
+
+      param_set = ps(
+        pValue = p_dbl(default = 0.01),
+        mcAdj = p_lgl(default = TRUE),
+        maxRuns = p_int(lower = 1, default = 100),
+        doTrace = p_int(lower = 0, upper = 4, default = 0),
+        holdHistory = p_lgl(default = TRUE),
+        getImp = p_uty(),
+        keep = p_fct(levels = c("confirmed", "tentative"), default = "confirmed")
+      )
+
+      param_set$set_values(keep = "confirmed")
+
+      super$initialize(
+        id = "boruta",
+        task_types = c("regr", "classif"),
+        param_set = param_set,
+        packages = "Boruta",
+        feature_types = c("integer", "numeric"),
+        label = "Burota",
+        man = "mlr3filters::mlr_filters_boruta"
+      )
+    }
+  ),
+
+  private = list(
+    .calculate = function(task, nfeat) {
+      pv = self$param_set$values
+      data = task$data()
+      target = task$target_names
+      features = task$feature_names
+      formula = formulate(target, features)
+      keep = pv$keep
+      pv$keep = NULL
+
+      res = invoke(Boruta::Boruta, formula = formula, data = data, .args = pv)
+
+      selected_features = if (keep == "confirmed") {
+        Boruta::getSelectedAttributes(res)
+      } else {
+        Boruta::getSelectedAttributes(res, withTentative = TRUE)
+      }
+
+      score = named_vector(features, init = 0)
+      replace(score, names(score) %in% selected_features, 1)
+    }
+  )
+)
+
+
+#' @include mlr_filters.R
+mlr_filters$add("boruta", FilterBoruta)

R/bibentries.R

@@ -34,5 +34,14 @@ bibentries = c(
     author = "Andrea Bommert and Thomas Welchowski and Matthias Schmid and J\u00f6rg Rahnenf\u00fchrer",
     title = "Benchmark of filter methods for feature selection in high-dimensional gene expression survival data",
     journal = "Briefings in Bioinformatics"
-  )
+  ),
+
+  kursa_2010 = bibentry("article",
+    title = "Feature Selection with the Boruta Package",
+    volume = "36",
+    number = "11",
+    journal = "Journal of Statistical Software",
+    author = "Miron B. Kursa and Witold R. Rudnicki",
+    year = "2010",
+    pages = "1-13")
 )