perf: directly use set() with a loop

Author: m-muecke

DESCRIPTION

@@ -28,7 +28,7 @@ Depends:
     R (>= 4.1.0)
 Imports:
     checkmate,
-    data.table (>= 1.16.0),
+    data.table,
     lgr,
     mlr3misc (>= 0.14.0),
     paradox,

R/PipeOpFDAInterpol.R

@@ -106,26 +106,26 @@ PipeOpFDAInterpol = R6Class("PipeOpFDAInterpol",
         if (length(grid) > 1L && !has_left && !has_right) {
           max_grid = max(grid)
           min_grid = min(grid)
-          dt[,
-            names(.SD) := map(.SD, function(x) {
-              domain = tf::tf_domain(x)
-              if (min_grid < domain[[1L]] || max_grid > domain[[2L]]) {
-                stopf("The grid must be within the range of the domain.")
-              }
-              invoke(tf::tfd, data = x, arg = grid, .args = list(evaluator = evaluator))
-            })
-          ]
+          for (j in seq_along(dt)) {
+            x = dt[[j]]
+            domain = tf::tf_domain(x)
+            if (min_grid < domain[[1L]] || max_grid > domain[[2L]]) {
+              stopf("The grid must be within the range of the domain.")
+            }
+            set(dt, j = j, value = invoke(tf::tfd, data = x, arg = grid, .args = list(evaluator = evaluator)))
+          }
           return(dt)
         }
         arg = seq(left, right, length.out = grid)
-        dt[,
-          names(.SD) := map(.SD, function(x) invoke(tf::tfd, data = x, arg = arg, .args = list(evaluator = evaluator)))
-        ]
+        for (j in seq_along(dt)) {
+          set(dt, j = j, value = invoke(tf::tfd, data = dt[[j]], arg = arg, .args = list(evaluator = evaluator)))
+        }
         return(dt)
       }
 
-      dt[,
-        names(.SD) := map(.SD, function(x) {
+      for (j in seq_along(dt)) {
+        x = dt[[j]]
+        if (tf::is_irreg(x)) {
           arg = tf::tf_arg(x)
           arg = switch(
             grid,
@@ -138,10 +138,9 @@ PipeOpFDAInterpol = R6Class("PipeOpFDAInterpol",
               arg[seq(which(lower == arg), which(upper == arg))]
             }
           )
-          invoke(tf::tfd, data = x, arg = arg, .args = list(evaluator = evaluator))
-        }),
-        .SDcols = tf::is_irreg
-      ]
+          set(dt, j = j, value = invoke(tf::tfd, data = x, arg = arg, .args = list(evaluator = evaluator)))
+        }
+      }
       dt
     }
   )

R/PipeOpFDAScaleRange.R

@@ -51,40 +51,40 @@ PipeOpFDAScaleRange = R6Class("PipeOpFDAScaleRange",
     .train_dt = function(dt, levels, target) {
       pars = self$param_set$get_values(tags = "train")
 
-      dt[,
-        names(.SD) := imap(.SD, function(x, nm) {
-          domain = tf::tf_domain(x)
-          scale = (pars$upper - pars$lower) / (domain[2L] - domain[1L])
-          offset = -domain[1L] * scale + pars$lower
-          self$state[[nm]] = list(domain = domain, scale = scale, offset = offset)
+      for (j in names(dt)) {
+        x = dt[[j]]
+        domain = tf::tf_domain(x)
+        scale = (pars$upper - pars$lower) / (domain[2L] - domain[1L])
+        offset = -domain[1L] * scale + pars$lower
+        self$state[[j]] = list(domain = domain, scale = scale, offset = offset)
 
-          args = tf::tf_arg(x)
-          if (tf::is_reg(x)) {
-            new_args = offset + args * scale
-          } else {
-            new_args = map(args, function(arg) offset + arg * scale)
-          }
-          invoke(tf::tfd, data = tf::tf_evaluations(x), arg = new_args)
-        })
-      ]
+        args = tf::tf_arg(x)
+        if (tf::is_reg(x)) {
+          new_args = offset + args * scale
+        } else {
+          new_args = map(args, function(arg) offset + arg * scale)
+        }
+        set(dt, j = j, value = invoke(tf::tfd, data = tf::tf_evaluations(x), arg = new_args))
+      }
+      dt
     },
 
     .predict_dt = function(dt, levels) {
-      dt[,
-        names(.SD) := imap(.SD, function(x, nm) {
-          trafo = self$state[[nm]]
-          if (!all(trafo$domain == tf::tf_domain(x))) {
-            stopf("Domain of new data does not match the domain of the training data.")
-          }
-          args = tf::tf_arg(x)
-          if (tf::is_reg(x)) {
-            new_args = trafo$offset + args * trafo$scale
-          } else {
-            new_args = map(args, function(arg) trafo$offset + arg * trafo$scale)
-          }
-          invoke(tf::tfd, data = tf::tf_evaluations(x), arg = new_args)
-        })
-      ]
+      for (j in names(dt)) {
+        x = dt[[j]]
+        trafo = self$state[[j]]
+        if (!all(trafo$domain == tf::tf_domain(x))) {
+          stopf("Domain of new data does not match the domain of the training data.")
+        }
+        args = tf::tf_arg(x)
+        if (tf::is_reg(x)) {
+          new_args = trafo$offset + args * trafo$scale
+        } else {
+          new_args = map(args, function(arg) trafo$offset + arg * trafo$scale)
+        }
+        set(dt, j = j, value = invoke(tf::tfd, data = tf::tf_evaluations(x), arg = new_args))
+      }
+      dt
     }
   )
 )

R/PipeOpFDASmooth.R

@@ -66,14 +66,18 @@ PipeOpFDASmooth = R6Class("PipeOpFDASmooth",
       pars = self$param_set$get_values()
 
       if (pars$verbose) {
-        dt[, names(.SD) := map(.SD, function(x) invoke(tf::tf_smooth, x = x, method = pars$method, .args = pars$args))]
-      } else {
-        dt[,
-          names(.SD) := map(.SD, function(x) {
-            suppressMessages(invoke(tf::tf_smooth, x = x, method = pars$method, .args = pars$args))
-          })
-        ]
+        for (j in seq_along(dt)) {
+          set(dt, j = j, value = invoke(tf::tf_smooth, x = dt[[j]], method = pars$method, .args = pars$args))
+        }
+        return(dt)
       }
+      for (j in seq_along(dt)) {
+        set(dt,
+          j = j,
+          value = suppressMessages(invoke(tf::tf_smooth, x = dt[[j]], method = pars$method, .args = pars$args))
+        )
+      }
+      dt
     }
   )
 )