From 069f05762b21ed0a499cbacd4b3a40c9303b3aa1 Mon Sep 17 00:00:00 2001 From: Max Kuhn Date: Wed, 12 Jul 2017 14:41:12 -0400 Subject: [PATCH] Finally made outcome_conversion legal --- pkg/caret/NAMESPACE | 1 + pkg/caret/R/misc.R | 2 ++ pkg/caret/R/recipes.R | 8 ++++---- pkg/caret/R/workflows.R | 17 +++++++++-------- pkg/caret/man/caret-internal.Rd | 3 +++ 5 files changed, 19 insertions(+), 12 deletions(-) diff --git a/pkg/caret/NAMESPACE b/pkg/caret/NAMESPACE index 76eb811c1..bcc1d074a 100644 --- 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 index 49873d05b..95371fcd5 100644 --- 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 index d7c7c2438..e37194c3f 100644 --- 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 index ae88d3ebc..5c89a8d80 100644 --- 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 index a69b55c8a..54e5870dc 100644 --- a/pkg/caret/man/caret-internal.Rd +++ b/pkg/caret/man/caret-internal.Rd @@ -29,6 +29,7 @@ \alias{rfStats} \alias{cforestStats} \alias{bagEarthStats} +\alias{outcome_conversion} \alias{predictionFunction} \alias{hasTerms} \alias{probFunction} @@ -57,6 +58,8 @@ cforestStats(x) bagEarthStats(x) +outcome_conversion(x, lv) + predictionFunction(method, modelFit, newdata, preProc = NULL, param = NULL) hasTerms(x)