PipeOpInfo, PipeOpIsomap

.gitignore

@@ -11,57 +11,44 @@
 *.swp
 doc
 Meta
-
 .vscode/*
 !.vscode/settings.json
 !.vscode/tasks.json
 !.vscode/launch.json
 !.vscode/extensions.json
 *.code-workspace
-
 # Local History for Visual Studio Code
 .history/
-
 # History files
 .Rhistory
 .Rapp.history
-
 # Session Data files
 .RData
-
 # User-specific files
 .Ruserdata
-
 # Example code in package build process
 *-Ex.R
-
 # Output files from R CMD build
 /*.tar.gz
-
 # Output files from R CMD check
 /*.Rcheck/
-
 # RStudio files
 .Rproj.user/
-
 # produced vignettes
 vignettes/*.html
 vignettes/*.pdf
-
 # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
 .httr-oauth
-
 # knitr and R markdown default cache directories
 *_cache/
 /cache/
-
 # Temporary files created by R markdown
 *.utf8.md
 *.knit.md
-
 # R Environment Variables
 .Renviron
-
 # pkgdown site
 docs/
 /Meta/
+logger_file
+.DS_Store

DESCRIPTION

@@ -101,7 +101,12 @@ Suggests:
     future,
     htmlwidgets,
     ranger,
-    themis
+    themis,
+    lgr,
+    checkmate,
+    dimRed,
+    RSpectra,
+    RANN
 ByteCompile: true
 Encoding: UTF-8
 Config/testthat/edition: 3
@@ -159,6 +164,8 @@ Collate:
     'PipeOpImputeMode.R'
     'PipeOpImputeOOR.R'
     'PipeOpImputeSample.R'
+    'PipeOpInfo.R'    
+    'PipeOpIsomap.R'
     'PipeOpKernelPCA.R'
     'PipeOpLearner.R'
     'PipeOpLearnerCV.R'

NAMESPACE

@@ -132,6 +132,8 @@ export(PipeOpImputeMedian)
 export(PipeOpImputeMode)
 export(PipeOpImputeOOR)
 export(PipeOpImputeSample)
+export(PipeOpInfo)
+export(PipeOpIsomap)
 export(PipeOpKernelPCA)
 export(PipeOpLearner)
 export(PipeOpLearnerCV)

R/Graph.R

@@ -720,6 +720,7 @@ graph_load_namespaces = function(self, info) {
 
 
 #' @export
+#' @method predict Graph
 predict.Graph = function(object, newdata, ...) {
   if (!object$is_trained) {
     stop("Cannot predict, Graph has not been trained yet")

R/PipeOpInfo.R

@@ -0,0 +1,146 @@
+#' @title Customizable Information Printer
+#'
+#' @usage NULL
+#' @name mlr_pipeops_info
+#' @format [`R6Class`][R6::R6Class] object inheriting from [`PipeOp`]
+#'
+#' @description
+#' Given input is printed in a customizable way.
+#'
+#'
+#' @section Construction:
+#' ```
+#' PipeOpInfo$new(id = "info", collect_multiplicity = FALSE, log_target = "lgr::mlr3/mlr3pipelines::info")
+#' ```
+#' * `ìd` :: `character(1)`\cr
+#'   Identifier of resulting object, default "info"
+#' * `printer` :: `list` \cr
+#'   User input, specified printer-functions defined for a new object-classes or used to override their counterparts in the `original_printer`
+#' * `collect_multiplicity` :: `logical(1)`\cr
+#'   If `TRUE`, the input is a [`Multiplicity`] collecting channel. This means, a
+#'   [`Multiplicity`] input/output, instead of multiple normal inputs/outputs, is accepted and the members are aggregated.
+#' * `log_target` :: `character(1)`\cr
+#'   Specifies how the output is printed, can either be assigned to a logger with a specified level, or can be printer in the
+#'   format "message", "warning" or "cat". When the log_target is specified as "none", the input will be printed as is.
+#'   Has either he form <output>::<argument1>::<argument2> for logger output otherwise "message", "warning", "cat" or none.
+#'
+#' @section Input and Output Channels:
+#' `PipeOpInfo` has one input channel called "input", it can take any type of input (*)
+#' `PipeOpInfo` has one output channel called "output", it can take any type of output (*)
+#'
+#' @section State:
+#' The `$state` is left empty (`list()`).
+#'
+#' @section Fields:
+#' Fields inherited from `PipeOp`, as well as:
+#' * `printer` :: `list`\cr
+#'   List that contains information on how a specific object-class should be printed to the console.
+#' * `log_target` :: `character(1)` \cr
+#'   Specifies how the printed console output should be displayed to the user.
+#'
+#' @section Methods:
+#' Only methods inherited from [`PipeOp`].
+#'
+#' @examples
+#' library("mlr3")
+#' poinfo = po("info")
+#' poinfo$train(list(tsk("mtcars")))
+#' poinfo$predict(list(tsk("penguins")))
+#'
+#' @family PipeOps
+#' @template seealso_pipeopslist
+#' @include PipeOp.R
+#' @export
+#'
+#'
+
+PipeOpInfo = R6Class("PipeOpInfo",
+  inherit = PipeOp,
+  public = list(
+    initialize = function(id = "info", printer = NULL, collect_multiplicity = FALSE, log_target = "lgr::mlr3/mlr3pipelines::info", param_vals = list()) {
+      assertString(log_target, pattern = "^(cat|none|warning|message|lgr::[^:]+::[^:]+)$")
+      inouttype = "*"
+      if (collect_multiplicity) {
+        inouttype = sprintf("[%s]", inouttype)
+      }
+      super$initialize(id, param_vals = param_vals,
+        input = data.table(name = "input", train = inouttype, predict = inouttype),
+        output = data.table(name = "output", train = inouttype, predict = inouttype)
+        #tag = "debug"
+      )
+      original_printer = list(
+        Task = crate(function(x) {
+          list(task = x, data = x$data()[, 1:min(10, ncol(x$data()))])
+        }),
+        Prediction = crate(function(x) {
+          tryCatch(list(prediction = x, score = x$score()), error = function(e) {list(prediction = x)})
+        }),
+        `NULL` = crate(function(x) "NULL"),
+        default = crate(function(x) x)
+      )
+      private$.printer = insert_named(original_printer, printer)
+      private$.log_target = log_target
+    }
+  ),
+  active = list(
+    printer = function(rhs) {
+      if (!missing(rhs)) stop("printer is read only.")
+      private$.printer
+    },
+    log_target = function(rhs) {
+      if (!missing(rhs)) stop("log_target is read only.")
+      private$.log_target
+    }
+  ),
+  private = list(
+    .printer = NULL,
+    .log_target = NULL,
+    .output = function(inputs, stage) {
+    input_class = class(inputs[[1]])
+      leftmost_class =
+        if (any(input_class %in% names(private$.printer))) {
+          input_class[input_class %in% names(private$.printer)][[1]]
+        } else {
+          "default"
+        }
+      if (!("default" %in% names(private$.printer))) {
+        stop("Object-class was not found and no default printer is available.")
+      }
+      specific_printer = private$.printer[[leftmost_class]]
+      log_target_split = strsplit(private$.log_target, "::")[[1]]
+      stage_string = sprintf("Object passing through PipeOp %s - %s", self$id, stage)
+      print_string = utils::capture.output({
+        cat(stage_string, "\n\n")
+        specific_printer(inputs[[1]])
+      })
+      if (log_target_split[[1]] == "lgr") {
+        logger = lgr::get_logger(log_target_split[[2]])
+        log_level = log_target_split[[3]]
+        logger$log(log_level, msg = print_string)
+      } else if (private$.log_target == "cat") {
+        cat(paste(print_string, collapse = "\n"))
+      } else if (private$.log_target == "message") {
+        message(paste(print_string, collapse = "\n"))
+      } else if (private$.log_target == "warning") {
+        warning(paste(print_string, collapse = "\n"))
+      } else if (private$.log_target == "none") {
+      } else {
+        stopf("Invalid log_target '%s'.", log_target)
+      }
+    },
+    .train = function(inputs, stage = "Training") {
+      self$state = list()
+      private$.output(inputs, stage)
+      inputs
+    },
+    .predict = function(inputs, stage = "Prediction") {
+      private$.output(inputs, stage)
+      inputs
+    },
+    .additional_phash_input = function() {
+      list(printer = self$printer, log_target = self$log_target)
+    }
+  )
+)
+
+mlr_pipeops$add("info", PipeOpInfo)

R/PipeOpIsomap.R

@@ -0,0 +1,105 @@
+#' @title Algorithm for Dimensionality Reduction
+#'
+#' @usage NULL
+#' @name mlr_pipeops_isomap
+#' @format [`R6Class`][R6::R6Class] object inheriting from [`PipeOpTaskPreproc`]
+#'
+#'
+#'
+#' @section Construction:
+#' ```
+#' PipeOpIsomap$new(id = "isomap", ...)
+#' ```
+#'
+#' * `ìd` :: `character(1)`\cr
+#'   Identifier of resulting object, default `"isomap"`
+#' * `param_vals` :: named `list`\cr
+#'   List of hyperparameter settings, overwriting the hyperparameter settings that would otherwise be set during construction. Default `list()`.
+#'
+#' @section Input and Output Channels:
+#' Input and output channels are inherited from [`PipeOpTaskPreproc`].
+#'
+#' The output is the input [`Task`][mlr3::Task] with the data projected on the lower dimension.
+#'
+#' @section State:
+#'
+#' @section Parameters:
+#' The parameters are the parameters inherited from [`PipeOpTaskPreproc`], as well as:
+#' * `knn` :: `numeric(1)`\cr
+#'   The number of nearest neighbors in the graph.
+#'   Initialized to 50.
+#' * `ndim` :: `numeric(1)`\cr
+#'   The number of embedding dimensions.
+#'   Initialized to 2.
+#' * `get_geod` :: `logical(1)`\cr
+#'   Determines whether the distance matrix should be kept in the `$state`
+#'   Initialized to `FALSE`.
+#' * `.mute` :: `character`\cr
+#'   A character vector containing the elements you want to mute during training (c("message", "output")).
+#'   Initialized to `character(0)`.
+#'
+#'
+#' @section Internals:
+#' Applies the Isomap Embedding from the `dimRed`-package.
+#'
+#' @section Fields:
+#' Only fields inherited from `PipeOp`.
+#'
+#' @section Methods:
+#'
+#'
+#' @examples
+#' po = po("isomap")
+#' po$train(list(tsk("iris")))[[1]]$data()
+#' po$predict(list(tsk("iris")))[[1]]$data()
+#'
+#'
+#' @family PipeOps
+#' @template seealso_pipeopslist
+#' @include PipeOpTaskPreproc.R
+#' @export
+#'
+
+PipeOpIsomap = R6Class("PipeOpIsomap",
+  inherit = PipeOpTaskPreproc,
+  public = list(
+    initialize = function(id = "isomap", param_vals = list()) {
+      ps = ps(
+        knn = p_int(default = 50, lower = 1, upper = Inf, tags = c("train", "isomap")),
+        ndim = p_int(default = 2, lower = 1, upper = Inf, tags = c("train", "isomap")),
+        get_geod = p_lgl(default = FALSE, tags = c("train", "isomap")),
+        .mute = p_uty(init = c("message", "output"), tags = c("train", "isomap"))
+      )
+      super$initialize(id = id, param_set = ps, param_vals = param_vals, packages = c("dimRed", "stats"))
+    }
+  ),
+  private = list(
+    .train_dt = function(dt, levels, target) {
+      embed_result = mlr3misc::invoke(.f = dimRed::embed, .data = dt, .method = "Isomap", .args = self$param_set$get_values(tags = "isomap"))
+      self$state = list(embed_result = embed_result)
+      embed_result@data@data
+    },
+    .predict_dt = function(dt, levels) {
+      dimRed::predict(self$state$embed_result, as.data.frame(dt))@data
+    }
+  )
+)
+
+mlr_pipeops$add("isomap", PipeOpIsomap)
+
+# po = po("isomap", .mute = "message")
+# po$param_set$get_values(tags = "train")
+
+
+# po$train(list(tsk("iris")))[[1]]$data()
+# po$predict(list(tsk("iris")))[[1]]$data()
+
+# po$train(list(tsk("mtcars")))
+# po$predict(list(tsk("mtcars")))[[1]]$data()
+
+# emb2 <- embed(iris[1:4], "Isomap", .mute = NULL, knn = 25)
+# emb3 <- predict(emb2, iris[1:4])
+
+# po = po("isomap", knn = 20, ndim = 2, get_geod = TRUE)
+# plot(po$train(list(tsk("mtcars")))[[1]]$data()[,2:3])
+

R/zzz.R

@@ -15,7 +15,7 @@ register_mlr3 = function() {
   x$pipeops$valid_tags = unique(c(x$pipeops$valid_tags,
     c("abstract", "meta", "missings", "feature selection", "imbalanced data",
     "data transform", "target transform", "ensemble", "robustify", "learner", "encode",
-     "multiplicity")))
+     "multiplicity", "debug")))
   x$pipeops$properties = c("validation", "internal_tuning")
 }