adds learners table and overloads lrn

DESCRIPTION

@@ -56,6 +56,7 @@ Suggests:
  ranger,
  rmarkdown,
  testthat,
+ tibble,
  xgboost
 RdMacros:
  mlr3misc

R/mlr3learners_table.R

@@ -0,0 +1,128 @@
+# Ideally this table would be created automatically and all required packages would be installed.
+# and loaded. Required packages are mlr3, mlr3learners, mlr3proba, and all packages in
+# mlr3learners org, also when ready other packages in mlr3verse that have learners implemented in
+# them.
+
+# library(mlr3)
+# library(mlr3learners)
+# library(mlr3proba)
+# library(data.table)
+extra_learners = rownames(available.packages(repos = "https://mlr3learners.github.io/mlr3learners.drat"))
+# install.packages(extra_learners, repos = "https://mlr3learners.github.io/mlr3learners.drat")
+lapply(extra_learners, require, character.only = TRUE, quietly = TRUE)
+
+# construct all learners in attached mlr3verse
+keys = mlr_learners$keys()
+# potential warnings are either that external package required but not installed or package built
+# under different R version
+all_lrns = suppressWarnings(mlr3::lrns(keys))
+
+# creates data.table with id split into name and class, as well as original id;
+# the mlr3 package that the learner is implemented in; external package it is interfaced from;
+# learner properties; feature types; and predict types
+#
+# may look better as tibble, option to print given in below function
+#
+# ideally this table is abstracted from the user and they access it through the getter below
+learner_table = data.table(t(rbindlist(list(mlr3misc::map(all_lrns, function(.x) {
+ idsplt = strsplit(.x$id, ".", TRUE)[[1]]
+ list(idsplt[[2]], idsplt[[1]], .x$id, strsplit(.x$man, "::", TRUE)[[1]][1],
+ .x$packages[1], .x$properties, .x$feature_types, .x$predict_types)
+})))))
+
+colnames(learner_table) = c("name", "class", "id", "mlr3_package", "required_package",
+ "properties", "feature_types", "predict_types")
+learner_table[,1:4] = lapply(learner_table[,1:4], as.character)
+rm(all_lrns, extra_learners, keys)
+
+# getter function for the mlr3 learner table, assume it is called `learner_table`
+# args:
+# hide_cols `character()`: specify which, if any, columns to hide
+# filter `list()`: named list of conditions to filter on, names correspond to column names
+# in table
+# tibble `logical(1)`: if TRUE returns table as tibble otherwise data.table
+#
+# examples:
+# list_mlr3learners(hide_cols = c("properties", "feature_types"),
+# filter = list(class = "surv", predict_types = "distr"))
+# list_mlr3learners(tibble = TRUE)
+list_mlr3learners = function(hide_cols = NULL, filter = NULL, tibble = FALSE) {
+
+ dt = copy(learner_table)
+
+ if (!is.null(filter)) {
+ if (!is.null(filter$class)) {
+ dt = subset(dt, class %in% filter$class)
+ }
+ if (!is.null(filter$mlr3_package)) {
+ dt = subset(dt, mlr3_package %in% filter$mlr3_package)
+ }
+ if (!is.null(filter$required_package)) {
+ dt = subset(dt, required_package %in% filter$required_package)
+ }
+ if (!is.null(filter$properties)) {
+ dt = subset(dt, mlr3misc::map_lgl(dt$properties,
+ function(.x) any(filter$properties %in% .x)))
+ }
+ if (!is.null(filter$feature_types)) {
+ dt = subset(dt, mlr3misc::map_lgl(dt$feature_types,
+ function(.x) any(filter$feature_types %in% .x)))
+ }
+ if (!is.null(filter$predict_types)) {
+ dt = subset(dt, mlr3misc::map_lgl(dt$predict_types,
+ function(.x) any(filter$predict_types %in% .x)))
+ }
+ }
+
+ if (!is.null(hide_cols)) {
+ dt = subset(dt, select = !(colnames(dt) %in% hide_cols))
+ }
+
+ if (tibble) {
+ return(tibble::tibble(dt))
+ } else {
+ return(dt)
+ }
+}
+
+
+# overloads lrn function to automatically detect and install learners from any packages in
+# mlr3verse. uses list_mlr3learners with filtering for the given key.
+# this should actually probably be implemented in mlr3misc::dictionary_sugar_get
+# however this would create a dependency loop unless the learners table also lives in mlr3misc.
+# a vectorised version of this for `lrns` follows naturally.
+#
+# the function filters the learner_table, searches to see if the required mlr3_package is installed
+# and if not uses usethis::ui_yeah to ask user to install, if yes then installed and learner loaded,
+# if not then errors
+#
+# args:
+# .key `character(1)`: learner key
+#
+# examples:
+#
+# lrn("classif.ranger")
+#
+# unloadNamespace("mlr3learners.coxboost")
+# utils::remove.packages("mlr3learners.coxboost")
+# lrn("surv.coxboost")
+
+lrn <- function(.key, ...) {
+ pkg <- unlist(subset(list_mlr3learners(), id == .key)$mlr3_package)
+ inst <- suppressWarnings(require(pkg, quietly = FALSE, character.only = TRUE))
+ if (!inst) {
+ ans <- usethis::ui_yeah(
+ sprintf("%s is not installed but is required, do you want to install this now?", pkg),
+ n_no = 1
+ )
+ if (ans) {
+ install.packages(pkg, repos = "https://mlr3learners.github.io/mlr3learners.drat")
+ } else {
+ stop(sprintf("%s is not installed but is required.", pkg))
+ }
+ }
+ mlr3misc::dictionary_sugar_get(mlr_learners, .key, ...)
+}
+
+
+