PipeOpBasisSplines

DESCRIPTION

@@ -101,7 +101,8 @@ Suggests:
     future,
     htmlwidgets,
     ranger,
-    themis
+    themis,
+    splines
 ByteCompile: true
 Encoding: UTF-8
 Config/testthat/edition: 3
@@ -188,6 +189,7 @@ Collate:
     'PipeOpSmote.R'
     'PipeOpSmoteNC.R'
     'PipeOpSpatialSign.R'
+    'PipeOpSplines.R'
     'PipeOpSubsample.R'
     'PipeOpTextVectorizer.R'
     'PipeOpThreshold.R'

NAMESPACE

@@ -164,6 +164,7 @@ export(PipeOpSelect)
 export(PipeOpSmote)
 export(PipeOpSmoteNC)
 export(PipeOpSpatialSign)
+export(PipeOpSplines)
 export(PipeOpSubsample)
 export(PipeOpTargetInvert)
 export(PipeOpTargetMutate)

R/PipeOpSplines.R

@@ -0,0 +1,115 @@
+#' @title Transforms Columns using Splines Methods by Constructing a Model Matrix
+#'
+#' @usage NULL
+#' @name mlr_pipeops_splines
+#' @format [`R6Class`][R6::R6Class] object inheriting from [`PipeOpTaskPreprocSimple`]/[`PipeOpTaskPreproc`]/[`PipeOp`].
+#'
+#' @description
+#' Transforms Columns using Splines Methods by Constructing a Model Matrix.
+#'
+#' @section Construction:
+#' ```
+#' po("splines", param_vals = list())
+#' ```
+#'
+#' * `id` :: `character(1)`\cr
+#'   Identifier of resulting object, default `"splines"`.
+#' * `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 selected columns transformed according to the specified Splines Method.
+#'
+#' @section State:
+#' The `$state` is a named `list` with the `$state` elements inherited from [`PipeOpTaskPreproc`].
+#'
+#' @section Parameters:
+#' The parameters are the parameters inherited from [`PipeOpTaskPreproc`], as well as:
+#' * `factor`  :: `character(1)` \cr
+#'   "Polynomial" when polynomial splines are applied [`splines::bs`] or
+#'   "natural" when natural natural splines are applied [`splines::bs`].
+#'   Default is "polynomial".
+#' * `df`  :: `integer(1)` \cr
+#'   Number of degrees of freedom for calculation of splines basis matrix.
+#'   Default is NULL.
+#'
+#' @section Internals:
+#' For creating the Splines uses the [`splines::bs`]/[`splines::ns`] function.
+#' Uses the [`stats::model.matrix()`] function.
+#'
+#' @section Fields:
+#' Only fields inherited from [`PipeOp`].
+#'
+#' @section Methods:
+#' Only methods inherited from [`PipeOpTaskPreprocSimple`]/[`PipeOpTaskPreproc`]/[`PipeOp`].
+#'
+#' @examples
+#' library("mlr3")
+#'
+#' task = tsk("iris")
+#' pop = po("splines")
+#'
+#' pop$train(list(task))[[1]]$data()
+#'
+#' @family PipeOps
+#' @template seealso_pipeopslist
+#' @include PipeOpTaskPreproc.R
+#' @export
+
+PipeOpSplines = R6Class("PipeOpSplines",
+  inherit = PipeOpTaskPreproc,
+  public = list(
+    initialize = function(id = "splines", param_vals = list()) {
+      ps = ps(
+        type = p_fct(levels = c("polynomial", "natural"), init = "natural", tags = c("train", "splines")),
+        df = p_int(lower = 1, upper = Inf, special_vals = list(NULL), init = NULL, tags = c("train", "splines")),
+        knots = p_uty(special_vals = list(NULL), init = NULL, tags = c("train", "splines")),
+        degree = p_int(lower = 1, upper = Inf, default = 3, depends = type == "polynomial", tags = c("train", "splines")),
+        intercept = p_lgl(init = FALSE, tags = c("train", "splines")),
+        Boundary.knots = p_uty(tags = c("train", "splines"))
+      )
+      super$initialize(id = id, param_set = ps, param_vals = param_vals, packages = c("splines", "stats"))
+    }
+  ),
+  private = list(
+    .train_dt = function(dt, levels, target) {
+      result = list()
+      bk = list()
+      pv = self$param_set$get_values(tags = "splines")
+        for (i in colnames(dt)) {
+          args = pv
+          args$type = NULL
+          args$Boundary.knots = self$state$Boundary.knots[[i]]
+          if (pv$type == "polynomial") {
+            result[[i]] = invoke(splines::bs, .args = args, x = dt[[i]], warn.outside = FALSE)
+          } else  {
+            result[[i]] = invoke(splines::ns, .args = args, x = dt[[i]])
+          }
+          colnames(result[[i]]) = paste0("splines.", i, ".", seq_len(ncol(result[[i]])))
+          bk[[i]] = attributes(splines::bs(dt[[i]]))$Boundary.knots
+        }
+        self$state$Boundary.knots = bk
+      result
+    },
+    .predict_dt = function(dt, levels) {
+      result = list()
+      pv = self$param_set$get_values(tags = "splines") # tag entfernen oben
+      for (i in colnames(dt)) {
+        args = pv
+        args$type = NULL
+        args$Boundary.knots = self$state$Boundary.knots[[i]]
+        if (pv$type == "polynomial") {
+          result[[i]] = invoke(splines::bs, .args = args, x = dt[[i]], warn.outside = FALSE)
+        } else  {
+          result[[i]] = invoke(splines::ns, .args = args, x = dt[[i]])
+        }
+          colnames(result[[i]]) = paste0("splines.", i, ".", seq_len(ncol(result[[i]])))
+      }
+      result
+    }
+  )
+)
+
+mlr_pipeops$add("splines", PipeOpSplines)

attic/PipeOpSPlines - testing code.R

@@ -0,0 +1,83 @@
+
+# po = po("splines", df = 1)
+# po_result = po$train(list(tsk("iris")))[[1]]$data()
+
+# po = po("splines", type = "polynomial", df = 2, degree = 4)
+# po_result = po$train(list(tsk("iris")))[[1]]$data()
+# po_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length) + splines::bs(Sepal.Width) + splines::bs(Petal.Length) + splines::bs(Petal.Width), data = iris)
+
+# selecting columns
+# sel_cyl = selector_grep("Sepal.Length")
+# pos = po("basissplines", affect_columns = sel_cyl)
+# pos_result = pos$train(list(tsk("iris")))[[1]]$data()
+# pos_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length), data = iris)
+
+
+# podf3 = po("basissplines", df = 3)
+# podf3_result = podf3$train(list(tsk("iris")))[[1]]$data()
+# podf3_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length, df = 3) + splines::bs(Sepal.Width, df = 3) + splines::bs(Petal.Length, df = 3) + splines::bs(Petal.Width, df = 3), data = iris)
+
+# podf4 = po("basissplines", df = 4)
+# podf4_result = podf4$train(list(tsk("iris")))[[1]]$data()
+# podf4_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length, df = 4) + splines::bs(Sepal.Width, df = 4) + splines::bs(Petal.Length, df = 4) + splines::bs(Petal.Width, df = 4), data = iris)
+
+# podf7 = po("basissplines", df = 7)
+# podf7_result = podf7$train(list(tsk("iris")))[[1]]$data()
+# podf7_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length, df = 7) + splines::bs(Sepal.Width, df = 7) + splines::bs(Petal.Length, df = 7) + splines::bs(Petal.Width, df = 7), data = iris)
+
+# podeg3df2 = po("basissplines", degree = 3, df = 2)
+# podeg3df2_result = podeg3df2$train(list(tsk("iris")))[[1]]$data()
+# podeg3df2_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length, degree = 3, df = 2) + splines::bs(Sepal.Width, degree = 3, df = 2) + splines::bs(Petal.Length, degree = 3, df = 2) + splines::bs(Petal.Width, degree = 3, df = 2), data = iris)
+
+
+# podeg5df8 = po("basissplines", degree = 5, df = 8)
+# podeg5df8_result = podeg5df8$train(list(tsk("iris")))[[1]]$data()
+# podeg5df8_result_calc = stats::model.matrix(Species ~ splines::bs(Sepal.Length, degree = 5, df = 8) + splines::bs(Sepal.Width, degree = 5, df = 8) + splines::bs(Petal.Length, degree = 5, df = 8) + splines::bs(Petal.Width, degree = 5, df = 8), data = iris)
+
+# pons = po("basissplines", factor = "natural")
+# pons_result = pons$train(list(tsk("iris")))[[1]]$data()
+# pons_result_calc = stats::model.matrix(Species ~ splines::ns(Sepal.Length) + splines::ns(Sepal.Width) + splines::ns(Petal.Length) + splines::ns(Petal.Width), data = iris)
+
+# pons_error = po("basissplines", factor = "natural", df = 3, degree = 4)
+
+# ponsdf5 = po("basissplines", factor = "natural", df = 5)
+# ponsdf5_result = ponsdf5$train(list(tsk("iris")))[[1]]$data()
+# ponsdf5_result_calc = stats::model.matrix(Species ~ splines::ns(Sepal.Length, df = 5) + splines::ns(Sepal.Width, df = 5) + splines::ns(Petal.Length, df = 5) + splines::ns(Petal.Width, df = 5), data = iris)
+
+
+
+
+# pop = po("basissplines", df = 5)
+# pop$train(list(tsk("mtcars")))[[1]]$data()
+
+# poc = po("basissplines", df = 4, factor = "natural")
+# poc$train(list(tsk("mtcars")))[[1]]$data()
+
+# df als hyperparameterf
+# das ziel ist es dass wir diese model.matrix für alle features kriegen
+# original features behalten dann feature_union ==> egaluser verantwortung
+
+
+#splines.cyl.1
+
+# task = tsk("mtcars")
+
+# list(task)[[1]]$data()
+# pop = po("modelmatrix", formula = ~ splines::ns(task$data()$cyl, 2) + splines::ns(task$data()$hp, 2) +
+#           splines::ns(task$data()$disp, 2) + splines::ns(task$data()$drat, 2) + splines::ns(task$data()$wt, 2) +
+#           splines::ns(task$data()$qsec, 2) + splines::ns(task$data()$vs, 2) + splines::ns(task$data()$am, 2) +
+#           splines::ns(task$data()$gear, 2) + splines::ns(task$data()$carb, 2))
+# pop$train(list(task))[[1]]$data()
+
+# pob = po("modelmatrix", formula = ~ splines::bs(task$data()$cyl, 2) + splines::bs(task$data()$hp, 2) +
+#           splines::bs(task$data()$disp, 2) + splines::bs(task$data()$drat, 2) + splines::bs(task$data()$wt, 2) +
+#           splines::bs(task$data()$qsec, 2) + splines::bs(task$data()$vs, 2) + splines::bs(task$data()$am, 2) +
+#           splines::bs(task$data()$gear, 2) + splines::bs(task$data()$carb, 2))
+
+# pob$train(list(task))[[1]]$data()
+
+
+# fit <- lm(mpg ~ splines::ns(cyl, df = 2) + splines::ns(hp, df = 2), data = mtcars)
+# model.matrix(fit) # this is what we want to get as a result from PipeOpSplineBasis
+
+# as.data.frame(stats::model.matrix(mpg ~ splines::ns(cyl, 2) + splines::ns(task$data()$hp, 2), data = mtcars))