bugfix in sparseLTS() regarding evaluating function calls in the corr…

…ect environment during tuning via prediction error estimation

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: robustHD
 Type: Package
 Title: Robust Methods for High-Dimensional Data
-Version: 0.7.2
-Date: 2021-11-23
+Version: 0.7.3
+Date: 2022-08-09
 Depends: 
     R (>= 3.5.0), 
     ggplot2 (>= 0.9.2), 
@@ -33,4 +33,4 @@ Authors@R: person("Andreas", "Alfons",
 Author: Andreas Alfons [aut, cre]
 Maintainer: Andreas Alfons <[email protected]>
 Encoding: UTF-8
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0

NEWS

@@ -1,3 +1,10 @@
+Changes in robustHD version 0.7.3
+
+    + Bugfix in sparseLTS(): function calls for fitting the model on training
+      sets (when selecting lambda via prediction error estimation) are now
+      evaluated in the correct environment
+
+
 Changes in robustHD version 0.7.2
 
     + Added CITATION file.

R/grouplars.R

@@ -65,13 +65,15 @@ grouplars <- function(x, y, sMax = NA, assign, robust = FALSE,
       funCall <- call[-remove]
       funCall$sMax <- sMax
       funCall$s <- s
+      # make sure function call is evaluated in the correct environment
+      parentEnv <- parent.frame(2)
       # call function perryFit() to perform prediction error estimation
       s <- seq(from=s[1], to=s[2])
       selectBest <- match.arg(selectBest)
       out <- perryFit(funCall, x=x, y=y, splits=splits,
                       predictArgs=list(s=s, recycle=TRUE), cost=cost,
-                      costArgs=costArgs, envir=parent.frame(2),
-                      ncores=ncores, cl=cl, seed=seed)
+                      costArgs=costArgs, envir=parentEnv, ncores=ncores,
+                      cl=cl, seed=seed)
       out <- perryReshape(out, selectBest=selectBest, seFactor=seFactor)
       fits(out) <- s
       # fit final model
@@ -80,7 +82,7 @@ grouplars <- function(x, y, sMax = NA, assign, robust = FALSE,
       funCall$s <- s[out$best]
       funCall$ncores <- call$ncores
       funCall$cl <- cl
-      out$finalModel <- eval(funCall, envir=parent.frame(2))
+      out$finalModel <- eval(funCall, envir=parentEnv)
       out$call <- call
       # assign class and return object
       class(out) <- c("perrySeqModel", class(out))

R/rlars.R

@@ -258,12 +258,14 @@ rlars.default <- function(x, y, sMax = NA, centerFun = median,
       call <- matchedCall[-remove]
       call$sMax <- sMax
       call$s <- s
+      # make sure function call is evaluated in the correct environment
+      parentEnv <- parent.frame()
       # call function perryFit() to perform prediction error estimation
       s <- seq(from=s[1], to=s[2])
       selectBest <- match.arg(selectBest)
       out <- perryFit(call, x=x, y=y, splits=splits,
                       predictArgs=list(s=s, recycle=TRUE), cost=cost,
-                      costArgs=costArgs, envir=parent.frame(),
+                      costArgs=costArgs, envir=parentEnv,
                       ncores=ncores, cl=cl, seed=seed)
       out <- perryReshape(out, selectBest=selectBest, seFactor=seFactor)
       fits(out) <- s
@@ -272,7 +274,7 @@ rlars.default <- function(x, y, sMax = NA, centerFun = median,
       call$y <- matchedCall$y
       call$s <- s[out$best]
       call$ncores <- matchedCall$ncores
-      out$finalModel <- eval(call, envir=parent.frame())
+      out$finalModel <- eval(call, envir=parentEnv)
       out$call <- matchedCall
       # assign class and return object
       class(out) <- c("perrySeqModel", class(out))

R/sparseLTS.R

@@ -349,22 +349,24 @@ sparseLTS.default <- function(x, y, lambda, mode = c("lambda", "fraction"),
                 "selectBest", "seFactor", "ncores", "cl", "seed")
     remove <- match(remove, names(matchedCall), nomatch=0)
     call <- matchedCall[-remove]
+    # make sure function call is evaluated in the correct environment
+    parentEnv <- parent.frame()
     # call function perryTuning() to perform prediction error estimation
     tuning <- list(lambda=if(mode == "fraction") frac else lambda)
     selectBest <- match.arg(selectBest)
     fit <- perryTuning(call, x=x, y=y, tuning=tuning, splits=splits,
                        predictArgs=list(fit="both"), cost=cost,
                        costArgs=costArgs, selectBest=selectBest,
-                       seFactor=seFactor, ncores=ncores, cl=cl,
-                       seed=seed)
+                       seFactor=seFactor, envir = parentEnv,
+                       ncores=ncores, cl=cl, seed=seed)
     # fit final model
     lambdaOpt <- unique(lambda[fit$best])
     call$x <- matchedCall$x
     call$y <- matchedCall$y
     call$lambda <- lambdaOpt
     call$mode <- NULL
     call$ncores <- matchedCall$ncores
-    finalModel <- eval(call)
+    finalModel <- eval(call, envir = parentEnv)
     # if optimal tuning parameter is different for reweighted and raw fit,
     # add information that indicates optimal values
     if(length(lambdaOpt)) {