feat: mda classif learner from old mlr2

NAMESPACE

@@ -45,6 +45,7 @@ export(LearnerClassifLSSVM)
 export(LearnerClassifLiblineaR)
 export(LearnerClassifLightGBM)
 export(LearnerClassifLogistic)
+export(LearnerClassifMda)
 export(LearnerClassifMdeb)
 export(LearnerClassifMob)
 export(LearnerClassifMultilayerPerceptron)

NEWS.md

@@ -12,6 +12,7 @@
   - `LearnerClassifAdaBoosting`
   - `Learner{Classif,Regr}Evtree`
   - `LearnerClassifKnn`
+  - `LearnerClassifMda`
   - `LearnerClassifRferns`
   - `LearnerClassifNeuralnet`
   - `LearnerRegrBrnn`

R/learner_mda_classif_mda.R

@@ -0,0 +1,98 @@
+#' @title Classification Discriminant Analysis Learner
+#' @author annanzrv
+#' @name mlr_learners_classif.mda
+#'
+#' @description
+#' Mixture Discriminant Analysis.
+#' Calls [mda::mda()] from \CRANpkg{mda}.
+#'
+#' @section Initial parameter values:
+#' * `keep.fitted`: Set to `FALSE` by default for speed.
+#'
+#' @templateVar id classif.mda
+#' @template learner
+#'
+#' @template seealso_learner
+#' @template example
+#' @export
+LearnerClassifMda = R6Class("LearnerClassifMda",
+  inherit = LearnerClassif,
+  public = list(
+    #' @description
+    #' Creates a new instance of this [R6][R6::R6Class] class.
+    initialize = function() {
+      param_set = ps(
+        criterion    = p_fct(default = "misclassification", levels = c("misclassification", "deviance"), tags = "train"),
+        dimension    = p_int(lower = 1L, tags = c("train", "predict")),
+        eps          = p_dbl(default = .Machine$double.eps, lower = 0, tags = "train"),
+        iter         = p_int(default = 5L, lower = 1L, tags = "train"),
+        keep.fitted  = p_lgl(default = TRUE, tags = "train"),
+        method       = p_fct(default = "polyreg", levels = c("polyreg", "mars", "bruto", "gen.ridge"), tags = "train"),
+        prior        = p_dbl(lower = 0, upper = 1, tags = "predict"),
+        start.method = p_fct(default = "kmeans", levels = c("kmeans", "lvq"), tags = "train"),
+        sub.df       = p_int(lower = 1L, tags = "train"),
+        subclasses   = p_int(default = 2L, tags = "train"),
+        tot.df       = p_int(lower = 1L, tags = "train"),
+        trace        = p_lgl(default = FALSE, tags = "train"),
+        tries        = p_int(default = 5L, lower = 1L, tags = "train"),
+        weights      = p_uty(tags = "train")
+      )
+
+      param_set$values = list(keep.fitted = FALSE)
+
+      super$initialize(
+        id = "classif.mda",
+        packages = "mda",
+        feature_types = c("integer", "numeric", "factor", "ordered"),
+        predict_types = c("response", "prob"),
+        param_set = param_set,
+        properties = c("twoclass", "multiclass"),
+        man = "mlr3extralearners::mlr_learners_classif.mda",
+        label = "Mixture Discriminant Analysis"
+      )
+    }
+  ),
+  private = list(
+    .train = function(task) {
+      # get parameters for training
+      pars = self$param_set$get_values(tags = "train")
+
+      # get formula and data
+      formula = task$formula()
+      data = task$data()
+
+      # handle method parameter
+      if (!is.null(pars$method)) {
+        if (is.character(pars$method)) {
+          pars$method = getFromNamespace(pars$method, "mda")
+        }
+      }
+
+      invoke(
+        mda::mda,
+        formula = formula,
+        data = data,
+        .args = pars
+      )
+    },
+    .predict = function(task) {
+      # get parameters with tag "predict"
+      pars = self$param_set$get_values(tags = "predict")
+
+      # get newdata and ensure same ordering in train and predict
+      newdata = ordered_features(task, self)
+
+      # Calculate predictions for the selected predict type
+      type = ifelse(self$predict_type == "response", "class", "posterior")
+      pred = invoke(predict, self$model, newdata = newdata, type = type, .args = pars)
+
+      if (self$predict_type == "response") {
+        list(response = pred)
+      } else {
+        list(prob = pred)
+      }
+    }
+  )
+)
+
+.extralrns_dict$add("classif.mda", LearnerClassifMda)

tests/testthat/test_mda_classif_mda.R

@@ -0,0 +1,9 @@
+skip_if_not_installed("mda")
+
+test_that("autotest", {
+  learner = lrn("classif.mda", subclasses = 2)
+  expect_learner(learner)
+  # note that you can skip tests using the exclude argument
+  result = run_autotest(learner)
+  expect_true(result, info = result$error)
+})

tests/testthat/test_paramtest_mda_classif_mda.R

@@ -0,0 +1,31 @@
+skip_if_not_installed("mda")
+
+test_that("classif.mda train", {
+  learner = lrn("classif.mda")
+  fun = mda::mda
+  exclude = c(
+    "formula", # handled internally
+    "data", # handled internally
+    formalArgs(mda::mda.start)  # handled internally by mda
+  )
+
+  # note that you can also pass a list of functions in case $.train calls more than one
+  # function, e.g. for control arguments
+  paramtest = run_paramtest(learner, fun, exclude, tag = "train")
+  expect_paramtest(paramtest)
+})
+
+test_that("classif.mda predict", {
+  learner = lrn("classif.mda")
+  fun = mda:::predict.mda # nolint
+  exclude = c(
+    "object", # handled internally
+    "data", # handled internally
+    "newdata", # handled internally
+    "type",  # handled internally
+    "g"# unknown in CRAN documentation of mda
+  )
+
+  paramtest = run_paramtest(learner, fun, exclude, tag = "predict")
+  expect_paramtest(paramtest)
+})