Finally made outcome_conversion legal

topepo · Jul 12, 2017 · 069f057 · 069f057
1 parent bf222f2
commit 069f057
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 12 deletions.
diff --git a/pkg/caret/NAMESPACE b/pkg/caret/NAMESPACE
@@ -331,6 +331,7 @@ export(nnetBag)
 export(nullModel)
 export(nzv)
 export(oneSE)
+export(outcome_conversion)
 export(panel.calibration)
 export(panel.lift)
 export(panel.lift2)

diff --git a/pkg/caret/R/misc.R b/pkg/caret/R/misc.R
@@ -553,6 +553,8 @@ get_range <- function(y) {
   if(class(y)[1] %in% c("numeric", "integer")) extendrange(y) else extendrange(y[, "time"])
 }
 
+#' @rdname caret-internal
+#' @export
 outcome_conversion <- function(x, lv) {
   if(is.factor(x) | is.character(x)) {
     if(!is.null(attributes(lv)) && any(names(attributes(lv)) == "ordered" && attr(lv, "ordered")))

diff --git a/pkg/caret/R/recipes.R b/pkg/caret/R/recipes.R
@@ -878,7 +878,7 @@ loo_train_rec <- function(rec, dat, info, method,
                 ## collate the predictions across all the sub-models
                 predicted <- lapply(predicted,
                                     function(x, lv, dat) {
-                                      x <- getFromNamespace("outcome_conversion", "caret")(x, lv = lev)
+                                      x <- outcome_conversion(x, lv = lev)
                                       dat$pred <- x
                                       dat
                                     },
@@ -896,7 +896,7 @@ loo_train_rec <- function(rec, dat, info, method,
                 predicted <- cbind(predicted, allParam)
                 ## if saveDetails then save and export 'predicted'
               } else {
-                pred_val <- getFromNamespace("outcome_conversion", "caret")(predicted, lv = lev)
+                pred_val <- outcome_conversion(predicted, lv = lev)
                 predicted <-  ho_data
                 predicted$pred <- pred_val
                 if(ctrl$classProbs) predicted <- cbind(predicted, probValues)
@@ -1083,7 +1083,7 @@ train_rec <- function(rec, dat, info, method, ctrl, lev, testing = FALSE, ...) {
         ## collate the predictions across all the sub-models
         predicted <- lapply(predicted,
                             function(x, lv, dat) {
-                              x <- getFromNamespace("outcome_conversion", "caret")(x, lv = lev)
+                              x <- outcome_conversion(x, lv = lev)
                               dat$pred <- x
                               dat
                             },
@@ -1123,7 +1123,7 @@ train_rec <- function(rec, dat, info, method, ctrl, lev, testing = FALSE, ...) {
         thisResample <- cbind(allParam, thisResample)
 
       } else {       
-        pred_val <- getFromNamespace("outcome_conversion", "caret")(predicted, lv = lev)
+        pred_val <- outcome_conversion(predicted, lv = lev)
         tmp <-  ho_data
         tmp$pred <- pred_val
         if(ctrl$classProbs) tmp <- cbind(tmp, probValues)

diff --git a/pkg/caret/R/workflows.R b/pkg/caret/R/workflows.R
@@ -1,9 +1,9 @@
 
-### In this file, there are a lot of functions form caret that are
-### references using the explicit namespace operator (:::). For some
-### reason, with some parallel processing technologies and foreach,
+### In this file, there are a lot of functions from packages that are
+### referenced using `getFromNamespace`. For some
+### reason, with _some_ parallel processing technologies and foreach,
 ### functions inside of caret cannot be found despite using the
-### ".packages" argument and calling the caret package via library().
+### ".packages" argument or even calling the caret package via library().
 
 getOper <- function(x) if(x)  `%dopar%` else  `%do%`
 getTrainOper <- function(x) if(x)  `%dopar%` else  `%do%`
@@ -82,6 +82,7 @@ nominalTrainWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev, tes
       if(!(length(ctrl$seeds) == 1 && is.na(ctrl$seeds))) set.seed(ctrl$seeds[[iter]][parm])
 
       loadNamespace("caret")
+
       if(ctrl$verboseIter) progress(printed[parm,,drop = FALSE],
                                     names(resampleIndex), iter)
 
@@ -202,7 +203,7 @@ nominalTrainWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev, tes
         ## collate the predicitons across all the sub-models
         predicted <- lapply(predicted,
                             function(x, y, wts, lv, rows) {
-                              x <- getFromNamespace("outcome_conversion", "caret")(x, lv = lev)
+                              x <- outcome_conversion(x, lv = lev)
                               out <- data.frame(pred = x, obs = y, stringsAsFactors = FALSE)
                               if(!is.null(wts)) out$weights <- wts
                               out$rowIndex <- rows
@@ -288,7 +289,7 @@ nominalTrainWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev, tes
         thisResample <- cbind(allParam, thisResample)
 
       } else {       
-        if(is.factor(y)) predicted <- getFromNamespace("outcome_conversion", "caret")(predicted, lv = lev)
+        if(is.factor(y)) predicted <- outcome_conversion(predicted, lv = lev)
         tmp <-  data.frame(pred = predicted,
                            obs = y[holdoutIndex],
                            stringsAsFactors = FALSE)
@@ -517,7 +518,7 @@ looTrainWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev, testing
         ## collate the predictions across all the sub-models
         predicted <- lapply(predicted,
                             function(x, y, wts, lv, rows) {
-                              x <- getFromNamespace("outcome_conversion", "caret")(x, lv = lev)
+                              x <- outcome_conversion(x, lv = lev)
                               out <- data.frame(pred = x, obs = y, stringsAsFactors = FALSE)
                               if(!is.null(wts)) out$weights <- wts
                               out$rowIndex <- rows
@@ -539,7 +540,7 @@ looTrainWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev, testing
         predicted <- cbind(predicted, allParam)
         ## if saveDetails then save and export 'predicted'
       } else {
-        predicted <- getFromNamespace("outcome_conversion", "caret")(predicted, lv = lev)
+        predicted <- outcome_conversion(predicted, lv = lev)
         predicted <-  data.frame(pred = predicted,
                                  obs = y[holdoutIndex],
                                  stringsAsFactors = FALSE)

diff --git a/pkg/caret/man/caret-internal.Rd b/pkg/caret/man/caret-internal.Rd