mlr-org · mllg · Aug 12, 2021 · Aug 4, 2021 · Aug 9, 2021
diff --git a/R/LearnerClassifCVGlmnet.R b/R/LearnerClassifCVGlmnet.R
@@ -59,7 +59,7 @@ LearnerClassifCVGlmnet = R6Class("LearnerClassifCVGlmnet",
         pmax             = p_int(0L, tags = "train"),
         pmin             = p_dbl(0, 1, default = 1.0e-9, tags = "train"),
         prec             = p_dbl(default = 1e-10, tags = "train"),
-        predict.gamma    = p_dbl(default = 1, tags = "predict"),
+        predict.gamma    = p_dbl(default = "gamma.1se", special_vals = list("gamma.1se", "gamma.min"), tags = "predict"),
         relax            = p_lgl(default = FALSE, tags = "train"),
         s                = p_dbl(0, special_vals = list("lambda.1se", "lambda.min"), default = "lambda.1se", tags = "predict"),
         standardize      = p_lgl(default = TRUE, tags = "train"),
@@ -77,56 +77,53 @@ LearnerClassifCVGlmnet = R6Class("LearnerClassifCVGlmnet",
         param_set = ps,
         predict_types = c("response", "prob"),
         feature_types = c("logical", "integer", "numeric"),
-        properties = c("weights", "twoclass", "multiclass"),
+        properties = c("weights", "twoclass", "multiclass", "selected_features"),
         packages = "glmnet",
         man = "mlr3learners::mlr_learners_classif.cv_glmnet"
       )
+    },
+
+    #' @description
+    #' Returns the set of selected features as reported by [glmnet::predict.glmnet()]
+    #' with `type` set to `"nonzero"`.
+    #'
+    #' @param lambda (`numeric(1)`)\cr
+    #' Custom `lambda`, defaults to the active lambda depending on parameter set.
+    #'
+    #' @return (`character()`) of feature names.
+    selected_features = function(lambda = NULL) {
+      glmnet_selected_features(self, lambda)
     }
   ),
 
   private = list(
     .train = function(task) {
-
-      pars = self$param_set$get_values(tags = "train")
       data = as.matrix(task$data(cols = task$feature_names))
       target = swap_levels(task$truth())
+      pv = self$param_set$get_values(tags = "train")
+      pv$family = ifelse(length(task$class_names) == 2L, "binomial", "multinomial")
       if ("weights" %in% task$properties) {
-        pars$weights = task$weights$weight
+        pv$weights = task$weights$weight
       }
-      pars$family = ifelse(length(task$class_names) == 2L, "binomial", "multinomial")
-
-      saved_ctrl = glmnet::glmnet.control()
-      on.exit(mlr3misc::invoke(glmnet::glmnet.control, .args = saved_ctrl))
-      glmnet::glmnet.control(factory = TRUE)
-      is_ctrl_pars = names(pars) %in% names(saved_ctrl)
 
-      if (any(is_ctrl_pars)) {
-        mlr3misc::invoke(glmnet::glmnet.control, .args = pars[is_ctrl_pars])
-        pars = pars[!is_ctrl_pars]
-      }
-
-      mlr3misc::invoke(glmnet::cv.glmnet, x = data, y = target, .args = pars)
+      glmnet_invoke(data, target, pv, cv = TRUE)
     },
 
     .predict = function(task) {
-      pars = self$param_set$get_values(tags = "predict")
       newdata = as.matrix(ordered_features(task, glmnet_feature_names(self$model)))
-
-      if (!is.null(pars$predict.gamma)) {
-        pars$gamma = pars$predict.gamma
-        pars$predict.gamma = NULL
-      }
+      pv = self$param_set$get_values(tags = "predict")
+      pv = rename(pv, "predict.gamma", "gamma")
 
       if (self$predict_type == "response") {
-        response = mlr3misc::invoke(predict, self$model,
+        response = invoke(predict, self$model,
           newx = newdata, type = "class",
-          .args = pars)
+          .args = pv)
 
         list(response = drop(response))
       } else {
-        prob = mlr3misc::invoke(predict, self$model,
+        prob = invoke(predict, self$model,
           newx = newdata, type = "response",
-          .args = pars)
+          .args = pv)
 
         if (length(task$class_names) == 2L) {
           # the docs are really not clear here; before we tried to reorder the class

diff --git a/R/LearnerClassifGlmnet.R b/R/LearnerClassifGlmnet.R
@@ -74,6 +74,7 @@ LearnerClassifGlmnet = R6Class("LearnerClassifGlmnet",
         pmax             = p_int(0L, tags = "train"),
         pmin             = p_dbl(0, 1, default = 1.0e-9, tags = "train"),
         prec             = p_dbl(default = 1e-10, tags = "train"),
+        predict.gamma    = p_dbl(default = 1, tags = "predict"),
         relax            = p_lgl(default = FALSE, tags = "train"),
         s                = p_dbl(0, default = 0.01, tags = "predict"),
         standardize      = p_lgl(default = TRUE, tags = "train"),
@@ -94,53 +95,49 @@ LearnerClassifGlmnet = R6Class("LearnerClassifGlmnet",
         packages = "glmnet",
         man = "mlr3learners::mlr_learners_classif.glmnet"
       )
+    },
+
+    #' @description
+    #' Returns the set of selected features as reported by [glmnet::predict.glmnet()]
+    #' with `type` set to `"nonzero"`.
+    #'
+    #' @param lambda (`numeric(1)`)\cr
+    #' Custom `lambda`, defaults to the active lambda depending on parameter set.
+    #'
+    #' @return (`character()`) of feature names.
+    selected_features = function(lambda = NULL) {
+      glmnet_selected_features(self, lambda)
     }
   ),
 
   private = list(
     .train = function(task) {
-
-      pars = self$param_set$get_values(tags = "train")
       data = as.matrix(task$data(cols = task$feature_names))
       target = swap_levels(task$truth())
+      pv = self$param_set$get_values(tags = "train")
+      pv$family = ifelse(length(task$class_names) == 2L, "binomial", "multinomial")
       if ("weights" %in% task$properties) {
-        pars$weights = task$weights$weight
-      }
-      pars$family = ifelse(length(task$class_names) == 2L, "binomial", "multinomial")
-
-      saved_ctrl = glmnet::glmnet.control()
-      on.exit(mlr3misc::invoke(glmnet::glmnet.control, .args = saved_ctrl))
-      glmnet::glmnet.control(factory = TRUE)
-      is_ctrl_pars = names(pars) %in% names(saved_ctrl)
-
-      if (any(is_ctrl_pars)) {
-        mlr3misc::invoke(glmnet::glmnet.control, .args = pars[is_ctrl_pars])
-        pars = pars[!is_ctrl_pars]
+        pv$weights = task$weights$weight
       }
 
-      mlr3misc::invoke(glmnet::glmnet, x = data, y = target, .args = pars)
+      glmnet_invoke(data, target, pv)
     },
 
     .predict = function(task) {
-      pars = self$param_set$get_values(tags = "predict")
       newdata = as.matrix(ordered_features(task, glmnet_feature_names(self$model)))
-
-      # if model was fit with more then one lambda,
-      # set to default such that only one prediction is returned
-      if (is.null(pars$s) & length(self$model$lambda) > 1L) {
-        warning("Multiple lambdas have been fit. For prediction, lambda will be set to 0.01 (see parameter 's').")
-        pars$s = self$param_set$default$s
-      }
+      pv = self$param_set$get_values(tags = "predict")
+      pv = rename(pv, "predict.gamma", "gamma")
+      pv$s = glmnet_get_lambda(self, pv)
 
       if (self$predict_type == "response") {
-        response = mlr3misc::invoke(predict, self$model,
+        response = invoke(predict, self$model,
           newx = newdata, type = "class",
-          .args = pars)
+          .args = pv)
         list(response = drop(response))
       } else {
-        prob = mlr3misc::invoke(predict, self$model,
+        prob = invoke(predict, self$model,
           newx = newdata, type = "response",
-          .args = pars)
+          .args = pv)
 
         if (length(task$class_names) == 2L) {
           # the docs are really not clear here; before we tried to reorder the class
@@ -151,6 +148,7 @@ LearnerClassifGlmnet = R6Class("LearnerClassifGlmnet",
         } else {
           prob = prob[, , 1L]
         }
+
         list(prob = prob)
       }
     }

diff --git a/R/LearnerClassifLDA.R b/R/LearnerClassifLDA.R
@@ -55,7 +55,7 @@ LearnerClassifLDA = R6Class("LearnerClassifLDA",
   private = list(
     .train = function(task) {
       formula = task$formula()
-      mlr3misc::invoke(MASS::lda, formula,
+      invoke(MASS::lda, formula,
         data = task$data(),
         .args = self$param_set$get_values(tags = "train"))
     },
@@ -71,7 +71,7 @@ LearnerClassifLDA = R6Class("LearnerClassifLDA",
         pars$predict.prior = NULL
       }
       newdata = task$data(cols = task$feature_names)
-      p = mlr3misc::invoke(predict, self$model,
+      p = invoke(predict, self$model,
         newdata = newdata,
         .args = self$param_set$get_values(tags = "predict"))
 

diff --git a/R/LearnerClassifLogReg.R b/R/LearnerClassifLogReg.R
@@ -74,7 +74,7 @@ LearnerClassifLogReg = R6Class("LearnerClassifLogReg",
       data = task$data()
       data[[tn]] = swap_levels(data[[tn]])
 
-      mlr3misc::invoke(stats::glm,
+      invoke(stats::glm,
         formula = task$formula(), data = data,
         family = "binomial", model = FALSE, .args = pars, .opts = opts_default_contrasts)
     },

diff --git a/R/LearnerClassifMultinom.R b/R/LearnerClassifMultinom.R
@@ -57,18 +57,18 @@ LearnerClassifMultinom = R6Class("LearnerClassifMultinom",
         pars$summ = as.integer(pars$summ)
       }
 
-      mlr3misc::invoke(nnet::multinom, data = data, .args = pars)
+      invoke(nnet::multinom, data = data, .args = pars)
     },
 
     .predict = function(task) {
       newdata = task$data(cols = task$feature_names)
       levs = task$class_names
 
       if (self$predict_type == "response") {
-        response = mlr3misc::invoke(predict, self$model, newdata = newdata, type = "class")
+        response = invoke(predict, self$model, newdata = newdata, type = "class")
         list(response = drop(response))
       } else {
-        prob = mlr3misc::invoke(predict, self$model, newdata = newdata, type = "probs")
+        prob = invoke(predict, self$model, newdata = newdata, type = "probs")
         if (length(levs) == 2L) {
           prob = matrix(c(1 - prob, prob), ncol = 2L, byrow = FALSE)
           colnames(prob) = levs

diff --git a/R/LearnerClassifNaiveBayes.R b/R/LearnerClassifNaiveBayes.R
@@ -42,7 +42,7 @@ LearnerClassifNaiveBayes = R6Class("LearnerClassifNaiveBayes",
     .train = function(task) {
       y = task$truth()
       x = task$data(cols = task$feature_names)
-      mlr3misc::invoke(e1071::naiveBayes,
+      invoke(e1071::naiveBayes,
         x = x, y = y,
         .args = self$param_set$get_values(tags = "train"))
     },
@@ -52,12 +52,12 @@ LearnerClassifNaiveBayes = R6Class("LearnerClassifNaiveBayes",
       newdata = task$data(cols = task$feature_names)
 
       if (self$predict_type == "response") {
-        response = mlr3misc::invoke(predict, self$model,
+        response = invoke(predict, self$model,
           newdata = newdata,
           type = "class", .args = pars)
         list(response = response)
       } else {
-        prob = mlr3misc::invoke(predict, self$model, newdata = newdata,
+        prob = invoke(predict, self$model, newdata = newdata,
           type = "raw", .args = pars)
         list(prob = prob)
       }

diff --git a/R/LearnerClassifNnet.R b/R/LearnerClassifNnet.R
@@ -81,21 +81,21 @@ LearnerClassifNnet = R6Class("LearnerClassifNnet",
     .train = function(task) {
       pars = self$param_set$get_values(tags = "train")
       if ("weights" %in% task$properties) {
-        pars = mlr3misc::insert_named(pars, list(weights = task$weights$weight))
+        pars = insert_named(pars, list(weights = task$weights$weight))
       }
       f = task$formula()
       data = task$data()
-      mlr3misc::invoke(nnet::nnet.formula, formula = f, data = data, .args = pars)
+      invoke(nnet::nnet.formula, formula = f, data = data, .args = pars)
     },
 
     .predict = function(task) {
       newdata = task$data(cols = task$feature_names)
 
       if (self$predict_type == "response") {
-        response = mlr3misc::invoke(predict, self$model, newdata = newdata, type = "class")
+        response = invoke(predict, self$model, newdata = newdata, type = "class")
         return(list(response = response))
       } else {
-        prob = mlr3misc::invoke(predict, self$model, newdata = newdata, type = "raw")
+        prob = invoke(predict, self$model, newdata = newdata, type = "raw")
         if (length(self$model$lev) == 2L) {
           prob = cbind(1 - prob, prob)
           colnames(prob) = self$model$lev

diff --git a/R/LearnerClassifQDA.R b/R/LearnerClassifQDA.R
@@ -52,7 +52,7 @@ LearnerClassifQDA = R6Class("LearnerClassifQDA",
 
   private = list(
     .train = function(task) {
-      mlr3misc::invoke(MASS::qda, task$formula(),
+      invoke(MASS::qda, task$formula(),
         data = task$data(),
         .args = self$param_set$get_values(tags = "train"))
     },
@@ -69,7 +69,7 @@ LearnerClassifQDA = R6Class("LearnerClassifQDA",
       }
 
       newdata = task$data(cols = task$feature_names)
-      p = mlr3misc::invoke(predict, self$model, newdata = newdata, .args = pars)
+      p = invoke(predict, self$model, newdata = newdata, .args = pars)
 
       if (self$predict_type == "response") {
         list(response = p$class)

diff --git a/R/LearnerClassifRanger.R b/R/LearnerClassifRanger.R
@@ -109,7 +109,7 @@ LearnerClassifRanger = R6Class("LearnerClassifRanger",
   private = list(
     .train = function(task) {
       pars = self$param_set$get_values(tags = "train")
-      mlr3misc::invoke(ranger::ranger,
+      invoke(ranger::ranger,
         dependent.variable.name = task$target_names,
         data = task$data(),
         probability = self$predict_type == "prob",
@@ -121,7 +121,7 @@ LearnerClassifRanger = R6Class("LearnerClassifRanger",
     .predict = function(task) {
       pars = self$param_set$get_values(tags = "predict")
       newdata = task$data(cols = task$feature_names)
-      p = mlr3misc::invoke(predict, self$model,
+      p = invoke(predict, self$model,
         data = newdata,
         predict.type = "response", .args = pars)
 

diff --git a/R/LearnerClassifSVM.R b/R/LearnerClassifSVM.R
@@ -76,7 +76,7 @@ LearnerClassifSVM = R6Class("LearnerClassifSVM",
       pars = self$param_set$get_values(tags = "predict")
       newdata = as_numeric_matrix(task$data(cols = task$feature_names))
       newdata = newdata[, self$state$feature_names, drop = FALSE]
-      p = mlr3misc::invoke(predict, self$model,
+      p = invoke(predict, self$model,
         newdata = newdata,
         probability = (self$predict_type == "prob"), .args = pars)
 

diff --git a/R/LearnerClassifXgboost.R b/R/LearnerClassifXgboost.R
@@ -182,7 +182,7 @@ LearnerClassifXgboost = R6Class("LearnerClassifXgboost",
         pars$watchlist = list(train = data)
       }
 
-      mlr3misc::invoke(xgboost::xgb.train, data = data, .args = pars)
+      invoke(xgboost::xgb.train, data = data, .args = pars)
     },
 
     .predict = function(task) {
@@ -199,7 +199,7 @@ LearnerClassifXgboost = R6Class("LearnerClassifXgboost",
 
       newdata = data.matrix(task$data(cols = task$feature_names))
       newdata = newdata[, model$feature_names, drop = FALSE]
-      pred = mlr3misc::invoke(predict, model, newdata = newdata, .args = pars)
+      pred = invoke(predict, model, newdata = newdata, .args = pars)
 
       if (nlvls == 2L) { # binaryclass
         if (pars$objective == "multi:softprob") {