fixed multi_predict column names

Author: topepo

R/aaa.R

@@ -33,7 +33,7 @@ utils::globalVariables(
     'lab', 'original', 'predicted_label', 'prediction', 'value', 'type',
     "neighbors", ".submodels", "has_submodel", "max_neighbor", "max_penalty",
     "max_terms", "max_tree", "name", "num_terms", "penalty", "trees",
-    "sub_neighbors")
+    "sub_neighbors", ".pred_class")
   )
 
 # nocov end

R/aaa_multi_predict.R

@@ -12,8 +12,10 @@
 #' @param ... Optional arguments to pass to `predict.model_fit(type = "raw")`
 #'  such as `type`.
 #' @return A tibble with the same number of rows as the data being predicted.
-#'  Mostly likely, there is a list-column named `.pred` that is a tibble with
-#'  multiple rows per sub-model.
+#'  There is a list-column named `.pred` that contains tibbles with
+#'  multiple rows per sub-model. Note that, within the tibbles, the column names
+#'  follow the usual standard based on prediction `type` (i.e. `.pred_class` for
+#'  `type = "class"` and so on).
 #' @export
 multi_predict <- function(object, ...) {
   if (inherits(object$fit, "try-error")) {

R/boost_tree.R

@@ -404,7 +404,7 @@ xgb_by_tree <- function(tree, object, new_data, type, ...) {
   } else {
     if (type == "class") {
       pred <- object$spec$method$pred$class$post(pred, object)
-      pred <- tibble(.pred = factor(pred, levels = object$lvl))
+      pred <- tibble(.pred_class = factor(pred, levels = object$lvl))
     } else {
       pred <- object$spec$method$pred$prob$post(pred, object)
       pred <- as_tibble(pred)
@@ -503,7 +503,7 @@ C50_by_tree <- function(tree, object, new_data, type, ...) {
 
   # switch based on prediction type
   if (type == "class") {
-    pred <- tibble(.pred = factor(pred, levels = object$lvl))
+    pred <- tibble(.pred_class = factor(pred, levels = object$lvl))
   } else {
     pred <- as_tibble(pred)
     names(pred) <- paste0(".pred_", names(pred))

R/logistic_reg.R

@@ -309,7 +309,7 @@ multi_predict._lognet <-
     if (is.null(type))
       type <- "class"
     if (!(type %in% c("class", "prob", "link", "raw"))) {
-      stop ("`type` should be either 'class', 'link', 'raw', or 'prob'.", call. = FALSE)
+      stop("`type` should be either 'class', 'link', 'raw', or 'prob'.", call. = FALSE)
     }
     if (type == "prob")
       dots$type <- "response"
@@ -321,12 +321,12 @@ multi_predict._lognet <-
     param_key <- tibble(group = colnames(pred), penalty = penalty)
     pred <- as_tibble(pred)
     pred$.row <- 1:nrow(pred)
-    pred <- gather(pred, group, .pred, -.row)
+    pred <- gather(pred, group, .pred_class, -.row)
     if (dots$type == "class") {
-      pred[[".pred"]] <- factor(pred[[".pred"]], levels = object$lvl)
+      pred[[".pred_class"]] <- factor(pred[[".pred_class"]], levels = object$lvl)
     } else {
       if (dots$type == "response") {
-        pred[[".pred2"]] <- 1 - pred[[".pred"]]
+        pred[[".pred2"]] <- 1 - pred[[".pred_class"]]
         names(pred) <- c(".row", "group", paste0(".pred_", rev(object$lvl)))
         pred <- pred[, c(".row", "group", paste0(".pred_", object$lvl))]
       }
@@ -371,3 +371,4 @@ predict_raw._lognet <- function(object, new_data, opts = list(), ...) {
   object$spec <- eval_args(object$spec)
   predict_raw.model_fit(object, new_data = new_data, opts = opts, ...)
 }
+

R/multinom_reg.R

@@ -290,7 +290,7 @@ multi_predict._multnet <-
       pred <-
         tibble(
           .row = rep(1:nrow(new_data), length(penalty)),
-          .pred = as.vector(pred),
+          .pred_class = as.vector(pred),
           penalty = rep(penalty, each = nrow(new_data))
         )
     }

man/multi_predict.Rd

@@ -119,7 +119,7 @@ test_that('glmnet prediction, mulitiple lambda', {
   mult_pred$rows <- rep(1:7, 2)
   mult_pred <- mult_pred[order(mult_pred$rows, mult_pred$penalty), ]
   mult_pred <- mult_pred[, c("penalty", "values")]
-  names(mult_pred) <- c("penalty", ".pred")
+  names(mult_pred) <- c("penalty", ".pred_class")
   mult_pred <- tibble::as_tibble(mult_pred)
 
   expect_equal(
@@ -148,7 +148,7 @@ test_that('glmnet prediction, mulitiple lambda', {
   form_pred$rows <- rep(1:7, 2)
   form_pred <- form_pred[order(form_pred$rows, form_pred$penalty), ]
   form_pred <- form_pred[, c("penalty", "values")]
-  names(form_pred) <- c("penalty", ".pred")
+  names(form_pred) <- c("penalty", ".pred_class")
   form_pred <- tibble::as_tibble(form_pred)
 
   expect_equal(
@@ -180,7 +180,7 @@ test_that('glmnet prediction, no lambda', {
   mult_pred$rows <- rep(1:7, 2)
   mult_pred <- mult_pred[order(mult_pred$rows, mult_pred$penalty), ]
   mult_pred <- mult_pred[, c("penalty", "values")]
-  names(mult_pred) <- c("penalty", ".pred")
+  names(mult_pred) <- c("penalty", ".pred_class")
   mult_pred <- tibble::as_tibble(mult_pred)
 
   expect_equal(mult_pred, multi_predict(xy_fit, lending_club[1:7, num_pred]) %>% unnest())
@@ -206,7 +206,7 @@ test_that('glmnet prediction, no lambda', {
   form_pred$rows <- rep(1:7, 2)
   form_pred <- form_pred[order(form_pred$rows, form_pred$penalty), ]
   form_pred <- form_pred[, c("penalty", "values")]
-  names(form_pred) <- c("penalty", ".pred")
+  names(form_pred) <- c("penalty", ".pred_class")
   form_pred <- tibble::as_tibble(form_pred)
 
   expect_equal(

tests/testthat/test_logistic_reg_glmnet.R

@@ -123,7 +123,7 @@ test_that('glmnet probabilities, mulitiple lambda', {
 
   mult_class <- names(mult_probs)[apply(mult_probs, 1, which.max)]
   mult_class <- tibble(
-    .pred = mult_class,
+    .pred_class = mult_class,
     penalty = rep(lams, each = 3),
     row = rep(1:3, 2)
   )