more fixes for tibble name repair

Author: topepo

R/aaa.R

@@ -1,7 +1,8 @@
 
 maybe_multivariate <- function(results, object) {
+
   if (isTRUE(ncol(results) > 1)) {
-    results <- as_tibble(results)
+    results <- as_tibble(results, .name_repair = "minimal")
   }  else {
     results <- unname(results[, 1])
   }

R/mlp.R

@@ -370,9 +370,18 @@ keras_mlp <-
     fit_call <- rlang::call_modify(fit_call, !!!arg_values$fit)
 
     history <- eval_tidy(fit_call)
+    model$y_names <- colnames(y)
     model
   }
 
+keras_numeric_post <- function(results, object) {
+  if (ncol(results) > 1) {
+    colnames(results) <- object$fit$y_names
+  }
+  maybe_multivariate(results, object)
+}
+
+
 
 nnet_softmax <- function(results, object) {
   if (ncol(results) == 1)

R/mlp_data.R

@@ -84,7 +84,7 @@ set_pred(
   type = "numeric",
   value = list(
     pre = NULL,
-    post = maybe_multivariate,
+    post = keras_numeric_post,
     func = c(fun = "predict"),
     args =
       list(

R/surv_reg.R

@@ -174,10 +174,10 @@ survreg_quant <- function(results, object) {
   pctl <- object$spec$method$pred$quantile$args$p
   n <- nrow(results)
   p <- ncol(results)
+  colnames(results) <- names0(p)
   results <-
     results %>%
     as_tibble() %>%
-    setNames(names0(p)) %>%
     mutate(.row = 1:n) %>%
     gather(.label, .pred, -.row) %>%
     arrange(.row, .label) %>%

tests/testthat/test_aaaa.R

@@ -4,7 +4,7 @@
 
 library(testthat)
 
-context("setting keras environment")
+context("setting keras environment\n")
 
 Sys.setenv(TF_CPP_MIN_LOG_LEVEL = '3')
 try(keras:::backend(), silent = TRUE)

tests/testthat/test_linear_reg.R

@@ -253,6 +253,15 @@ test_that('lm execution', {
     regexp = NA
   )
 
+  expect_error(
+    res <- fit_xy(
+      iris_basic,
+      x = iris[, 1:2],
+      y = iris[3:4],
+      control = ctrl
+    ),
+    regexp = NA
+  )
 })
 
 test_that('lm prediction', {

tests/testthat/test_mars.R

@@ -159,6 +159,16 @@ test_that('mars execution', {
     ),
     regexp = NA
   )
+
+  expect_error(
+    res <- fit_xy(
+      iris_basic,
+      x = iris[, 1:2],
+      y = iris[3:4],
+      control = ctrl
+    ),
+    regexp = NA
+  )
   parsnip:::load_libs(res, attach = TRUE)
 
 })

tests/testthat/test_mlp_keras.R

@@ -16,6 +16,8 @@ ctrl <- fit_control(verbosity = 1, catch = FALSE)
 caught_ctrl <- fit_control(verbosity = 1, catch = TRUE)
 quiet_ctrl <- fit_control(verbosity = 0, catch = TRUE)
 
+nn_dat <- read.csv("nnet_test.txt")
+
 # ------------------------------------------------------------------------------
 
 test_that('keras execution, classification', {
@@ -102,8 +104,8 @@ test_that('keras classification probabilities', {
   )
 
   xy_pred <- keras::predict_proba(xy_fit$fit, x = as.matrix(iris[1:8, num_pred]))
-  xy_pred <- as_tibble(xy_pred)
   colnames(xy_pred) <- paste0(".pred_", levels(iris$Species))
+  xy_pred <- as_tibble(xy_pred)
   expect_equal(xy_pred, predict(xy_fit, new_data = iris[1:8, num_pred], type = "prob"))
 
   keras::backend()$clear_session()
@@ -116,8 +118,8 @@ test_that('keras classification probabilities', {
   )
 
   form_pred <- keras::predict_proba(form_fit$fit, x = as.matrix(iris[1:8, num_pred]))
-  form_pred <- as_tibble(form_pred)
   colnames(form_pred) <- paste0(".pred_", levels(iris$Species))
+  form_pred <- as_tibble(form_pred)
   expect_equal(form_pred, predict(form_fit, new_data = iris[1:8, num_pred], type = "prob"))
 
   keras::backend()$clear_session()
@@ -204,8 +206,6 @@ test_that('keras regression prediction', {
 
 # ------------------------------------------------------------------------------
 
-nn_dat <- read.csv("nnet_test.txt")
-
 test_that('multivariate nnet formula', {
   skip_on_cran()
   skip_if_not_installed("keras")
@@ -218,6 +218,7 @@ test_that('multivariate nnet formula', {
       data = nn_dat[-(1:5),]
     )
   expect_equal(length(unlist(keras::get_weights(nnet_form$fit))), 24)
+
   nnet_form_pred <- predict(nnet_form, new_data = nn_dat[1:5, -(1:3)])
   expect_equal(names(nnet_form_pred), paste0(".pred_", c("V1", "V2", "V3")))