fixes for as_tibble.matrix with no colnames

Author: topepo

R/mlp.R

@@ -379,8 +379,9 @@ nnet_softmax <- function(results, object) {
     results <- cbind(1 - results, results)
 
   results <- apply(results, 1, function(x) exp(x)/sum(exp(x)))
-  results <- as_tibble(t(results))
+  results <- t(results)
   names(results) <- paste0(".pred_", object$lvl)
+  results <- as_tibble(results)
   results
 }
 

R/mlp_data.R

@@ -139,8 +139,8 @@ set_pred(
   value = list(
     pre = NULL,
     post = function(x, object) {
-      x <- as_tibble(x)
       colnames(x) <- object$lvl
+      x <- as_tibble(x)
       x
     },
     func = c(pkg = "keras", fun = "predict_proba"),

R/multinom_reg_data.R

@@ -216,8 +216,8 @@ set_pred(
   value = list(
     pre = NULL,
     post = function(x, object) {
-      x <- as_tibble(x)
       colnames(x) <- object$lvl
+      x <- as_tibble(x)
       x
     },
     func = c(pkg = "keras", fun = "predict_proba"),

R/nullmodel.R

@@ -111,14 +111,15 @@ predict.nullmodel <- function (object, new_data = NULL, type  = NULL, ...) {
       out <- factor(rep(object$value, n), levels = object$levels)
     }
   } else {
-    if(type %in% c("prob", "class")) stop("Only numeric predicitons are applicable to regression models")
-    if(length(object$value) == 1) {
+    if (type %in% c("prob", "class")) {
+      stop("Only numeric predicitons are applicable to regression models")
+    }
+    if (length(object$value) == 1) {
       out <- rep(object$value, n)
     } else {
-      out <- as_tibble(matrix(rep(object$value, n),
-                              ncol = length(object$value), byrow = TRUE))
-
-      names(out) <- names(object$value)
+      out <- matrix(rep(object$value, n), ncol = length(object$value), byrow = TRUE)
+      colnames(out) <- names(object$value)
+      out <- as_tibble(out)
     }
   }
   out

R/nullmodel_data.R

@@ -95,7 +95,6 @@ set_pred(
   value = list(
     pre = NULL,
     post = function(x, object) {
-      str(as_tibble(x))
       as_tibble(x)
     },
     func = c(fun = "predict"),

tests/testthat/test_logistic_reg_keras.R

@@ -160,10 +160,9 @@ test_that('classification probabilities', {
       y = tr_dat$Class
     )
 
-  keras_pred <-
-    keras::predict_proba(lr_fit$fit, as.matrix(te_dat[, -1])) %>%
-    as_tibble() %>%
-    setNames(paste0(".pred_", lr_fit$lvl))
+  keras_pred <- keras::predict_proba(lr_fit$fit, as.matrix(te_dat[, -1]))
+  colnames(keras_pred) <- paste0(".pred_", lr_fit$lvl)
+  keras_pred <- as_tibble(keras_pred)
 
   parsnip_pred <- predict(lr_fit, te_dat[, -1], type = "prob")
   expect_equal(as.data.frame(keras_pred), as.data.frame(parsnip_pred))
@@ -177,10 +176,10 @@ test_that('classification probabilities', {
       y = tr_dat$Class
     )
 
-  keras_pred <-
-    keras::predict_proba(plrfit$fit, as.matrix(te_dat[, -1])) %>%
-    as_tibble() %>%
-    setNames(paste0(".pred_", lr_fit$lvl))
+  keras_pred <- keras::predict_proba(plrfit$fit, as.matrix(te_dat[, -1]))
+  colnames(keras_pred) <- paste0(".pred_", lr_fit$lvl)
+  keras_pred <- as_tibble(keras_pred)
+
   parsnip_pred <- predict(plrfit, te_dat[, -1], type = "prob")
   expect_equal(as.data.frame(keras_pred), as.data.frame(parsnip_pred))