Merge pull request #905 from tidyverse/f-797-as-tibble-row-arbitrary

- `as_tibble_row()` supports arbitrary vectors (#797).

Author: krlmlr

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]], "."
   ))
 }
 

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"),

man/as_tibble.Rd

@@ -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
-      <error/tibble_error_as_tibble_row_bare>
-      `x` must be a bare vector in `as_tibble_row()`, not environment.
+      <error/tibble_error_as_tibble_row_vector>
+      `x` must be a vector in `as_tibble_row()`, not environment.
     Code
       error_as_tibble_row_size_one(3, "foo", 7)
     Output

tests/testthat/_snaps/msg.md

@@ -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])
+    )
   )
 })
 

tests/testthat/test-as_tibble.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"