diff --git a/R/as_tibble.R b/R/as_tibble.R index 98d52613c..e3e95fe4a 100644 --- a/R/as_tibble.R +++ b/R/as_tibble.R @@ -270,9 +270,7 @@ as_tibble.default <- function(x, ...) { #' @description #' `as_tibble_row()` converts a vector to a tibble with one row. -#' The input must be a bare vector, e.g. vectors of dates are not -#' supported yet. -#' If the input is a list, all elements must have length one. +#' If the input is a list, all elements must have size one. #' #' @rdname as_tibble #' @export @@ -284,15 +282,24 @@ as_tibble.default <- function(x, ...) { as_tibble_row <- function(x, .name_repair = c("check_unique", "unique", "universal", "minimal")) { - if (!is_bare_vector(x)) { - # FIXME: Remove entry from help once fixed (#797) - cnd_signal(error_as_tibble_row_bare(x)) + if (!vec_is(x)) { + cnd_signal(error_as_tibble_row_vector(x)) } - x <- set_repaired_names(x, repair_hint = TRUE, .name_repair) + names <- vectbl_names2(x, .name_repair = .name_repair) + + # FIXME: Use vec_chop2() when https://github.com/r-lib/vctrs/pull/1226 is in + if (is_bare_list(x)) { + slices <- x + } else { + x <- vec_set_names(x, NULL) + slices <- lapply(seq_len(vec_size(x)), vec_slice, x = x) + names(slices) <- names + } + + check_all_lengths_one(slices) - check_all_lengths_one(x) - new_tibble(as.list(x), nrow = 1) + new_tibble(slices, nrow = 1) } check_all_lengths_one <- function(x) { @@ -346,9 +353,9 @@ error_column_scalar_type <- function(names, positions, classes) { ) } -error_as_tibble_row_bare <- function(x) { +error_as_tibble_row_vector <- function(x) { tibble_error(paste0( - "`x` must be a bare vector in `as_tibble_row()`, not ", class(x)[[1]], "." + "`x` must be a vector in `as_tibble_row()`, not ", class(x)[[1]], "." )) } diff --git a/R/names.R b/R/names.R index 5eb3bf889..00482bba6 100644 --- a/R/names.R +++ b/R/names.R @@ -1,3 +1,11 @@ +vectbl_names2 <- function(x, + .name_repair = c("check_unique", "unique", "universal", "minimal"), + quiet = FALSE) { + + name <- vec_names2(x, repair = "minimal", quiet = quiet) + repaired_names(name, repair_hint = TRUE, .name_repair = .name_repair, quiet = quiet) +} + set_repaired_names <- function(x, repair_hint, .name_repair = c("check_unique", "unique", "universal", "minimal"), diff --git a/man/as_tibble.Rd b/man/as_tibble.Rd index 5caad9d4f..66a363eeb 100644 --- a/man/as_tibble.Rd +++ b/man/as_tibble.Rd @@ -111,9 +111,7 @@ that implements tibble's treatment of \link{rownames}. } \code{as_tibble_row()} converts a vector to a tibble with one row. -The input must be a bare vector, e.g. vectors of dates are not -supported yet. -If the input is a list, all elements must have length one. +If the input is a list, all elements must have size one. \code{as_tibble_col()} converts a vector to a tibble with one column. } diff --git a/tests/testthat/_snaps/msg.md b/tests/testthat/_snaps/msg.md index 703bed590..dee121ef3 100644 --- a/tests/testthat/_snaps/msg.md +++ b/tests/testthat/_snaps/msg.md @@ -90,10 +90,10 @@ x Column `C` is c. x ... and 23 more problems. Code - error_as_tibble_row_bare(new_environment()) + error_as_tibble_row_vector(new_environment()) Output - - `x` must be a bare vector in `as_tibble_row()`, not environment. + + `x` must be a vector in `as_tibble_row()`, not environment. Code error_as_tibble_row_size_one(3, "foo", 7) Output diff --git a/tests/testthat/test-as_tibble.R b/tests/testthat/test-as_tibble.R index fbc6f3748..e4c165095 100644 --- a/tests/testthat/test-as_tibble.R +++ b/tests/testthat/test-as_tibble.R @@ -416,18 +416,41 @@ test_that("as_tibble_row() can convert named bare vectors to data frame", { ) }) -test_that("as_tibbe_row() fails with non-bare vectors (#739)", { +test_that("as_tibble_row() works with non-bare vectors (#797)", { expect_tibble_error( - as_tibble_row(Sys.time()), - error_as_tibble_row_bare(Sys.time()) + as_tibble_row(new_environment()), + error_as_tibble_row_vector(new_environment()) ) - expect_tibble_error( - as_tibble_row(iris), - error_as_tibble_row_bare(iris) + + time <- vec_slice(Sys.time(), 1) + expect_identical( + as_tibble_row(time, .name_repair = "unique"), + tibble(...1 = time) ) - expect_tibble_error( + expect_identical( + as_tibble_row(trees[1:3, ], .name_repair = "unique"), + tibble( + ...1 = remove_rownames(trees[1, ]), + ...2 = remove_rownames(trees[2, ]), + ...3 = remove_rownames(trees[3, ]) + ) + ) + + remove_first_dimname <- function(x) { + dn <- dimnames(x) + dn[1] <- list(NULL) + dimnames(x) <- dn + x + } + + expect_identical( as_tibble_row(Titanic), - error_as_tibble_row_bare(Titanic) + tibble( + "1st" = remove_first_dimname(Titanic[1,,,, drop = FALSE]), + "2nd" = remove_first_dimname(Titanic[2,,,, drop = FALSE]), + "3rd" = remove_first_dimname(Titanic[3,,,, drop = FALSE]), + Crew = remove_first_dimname(Titanic[4,,,, drop = FALSE]) + ) ) }) diff --git a/tests/testthat/test-msg.R b/tests/testthat/test-msg.R index bddb59800..926db50e0 100644 --- a/tests/testthat/test-msg.R +++ b/tests/testthat/test-msg.R @@ -30,7 +30,7 @@ test_that("output test", { error_column_scalar_type(letters[2:3], 3:4, c("name", "NULL")) error_column_scalar_type(c("", "", LETTERS), 1:28, c("QQ", "VV", letters)) - error_as_tibble_row_bare(new_environment()) + error_as_tibble_row_vector(new_environment()) error_as_tibble_row_size_one(3, "foo", 7) "# class-tbl_df"