Merge pull request #904 from tidyverse/f-730-enframe-vec-2

- `enframe()` and `deframe()` support arbitrary vectors (#730).

NAMESPACE

@@ -95,9 +95,11 @@ importFrom(vctrs,vec_as_names_legacy)
 importFrom(vctrs,vec_as_subscript2)
 importFrom(vctrs,vec_c)
 importFrom(vctrs,vec_is)
+importFrom(vctrs,vec_names2)
 importFrom(vctrs,vec_ptype_abbr)
 importFrom(vctrs,vec_rbind)
 importFrom(vctrs,vec_recycle)
+importFrom(vctrs,vec_set_names)
 importFrom(vctrs,vec_size)
 importFrom(vctrs,vec_slice)
 useDynLib(tibble, .registration = TRUE)

R/enframe.R

@@ -24,22 +24,24 @@ enframe <- function(x, name = "name", value = "value") {
     cnd_signal(error_enframe_value_null())
   }
 
-  if (length(dim(x)) > 1) {
-    cnd_signal(error_enframe_has_dim(x))
+  if (is.null(x)) {
+    x <- logical()
   }
 
-  if (is.null(x)) x <- logical()
+  if (!vec_is(x)) {
+    cnd_signal(error_enframe_must_be_vector(x))
+  }
 
   if (is.null(name)) {
-    df <- list(unname(x))
+    df <- list(vec_set_names(x, NULL))
   } else if (is.null(names(x))) {
-    df <- list(seq_along(x), x)
+    df <- list(seq_len(vec_size(x)), x)
   } else {
-    df <- list(names(x), unname(x))
+    df <- list(vec_names2(x), vec_set_names(x, NULL))
   }
 
   names(df) <- c(name, value)
-  new_tibble(df, nrow = length(x))
+  new_tibble(df, nrow = vec_size(x))
 }
 
 #' @rdname enframe
@@ -61,14 +63,15 @@ deframe <- function(x) {
 
   value <- x[[2L]]
   name <- x[[1L]]
-  names(value) <- name
-  value
+  vec_set_names(value, as.character(name))
 }
 
 error_enframe_value_null <- function() {
   tibble_error("`value` can't be NULL.")
 }
 
-error_enframe_has_dim <- function(x) {
-  tibble_error(paste0("`x` must not have more than one dimension. `length(dim(x))` must be zero or one, not ", length(dim(x)), "."))
+error_enframe_must_be_vector <- function(x) {
+  tibble_error(paste0(
+    "The `x` argument to `enframe()` must be a vector, not ", class(x)[[1]], "."
+  ))
 }

R/tibble-package.R

@@ -7,6 +7,7 @@
 #' @importFrom vctrs vec_as_location vec_as_location2 vec_as_names vec_as_names_legacy vec_c
 #' @importFrom vctrs vec_is vec_rbind vec_recycle vec_size vec_slice vec_slice<-
 #' @importFrom vctrs unspecified vec_as_subscript2 num_as_location vec_ptype_abbr
+#' @importFrom vctrs vec_names2 vec_set_names
 #' @aliases NULL tibble-package
 #' @details
 #' `r lifecycle::badge("stable")`

tests/testthat/_snaps/enframe.md

@@ -5,7 +5,46 @@
     Error <tibble_error_enframe_value_null>
       `value` can't be NULL.
     Code
-      enframe(Titanic)
-    Error <tibble_error_enframe_has_dim>
-      `x` must not have more than one dimension. `length(dim(x))` must be zero or one, not 4.
+      nrow(enframe(Titanic))
+    Output
+      [1] 4
+    Code
+      enframe(Titanic)$value
+    Output
+      , , Age = Child, Survived = No
+      
+            Sex
+      Class  Male Female
+        1st     0      0
+        2nd     0      0
+        3rd    35     17
+        Crew    0      0
+      
+      , , Age = Adult, Survived = No
+      
+            Sex
+      Class  Male Female
+        1st   118      4
+        2nd   154     13
+        3rd   387     89
+        Crew  670      3
+      
+      , , Age = Child, Survived = Yes
+      
+            Sex
+      Class  Male Female
+        1st     5      1
+        2nd    11     13
+        3rd    13     14
+        Crew    0      0
+      
+      , , Age = Adult, Survived = Yes
+      
+            Sex
+      Class  Male Female
+        1st    57    140
+        2nd    14     80
+        3rd    75     76
+        Crew  192     20
+      
 

tests/testthat/_snaps/msg.md

@@ -118,10 +118,10 @@
       <error/tibble_error_enframe_value_null>
       `value` can't be NULL.
     Code
-      error_enframe_has_dim(Titanic)
+      error_enframe_must_be_vector(lm(speed ~ ., cars))
     Output
-      <error/tibble_error_enframe_has_dim>
-      `x` must not have more than one dimension. `length(dim(x))` must be zero or one, not 4.
+      <error/tibble_error_enframe_must_be_vector>
+      The `x` argument to `enframe()` must be a vector, not lm.
     Code
       # # names
       error_column_names_cannot_be_empty(1, repair_hint = TRUE)

tests/testthat/helper-zzz.R

@@ -100,6 +100,11 @@ skip_enh_bullets_format <- function() {
   skip_legacy()
 }
 
+skip_enh_enframe_vector <- function() {
+  # ENH: enframe() supports all vectors (#730)
+  skip_legacy()
+}
+
 skip_int_error_unknown_names <- function() {
   # INT: error_unknown_names() no longer implemented
   skip_legacy()

tests/testthat/test-enframe.R

@@ -60,10 +60,10 @@ test_that("can't use value = NULL", {
   )
 })
 
-test_that("can't pass objects with dimensions", {
+test_that("can't pass non-vector", {
   expect_tibble_error(
-    enframe(iris),
-    error_enframe_has_dim(iris)
+    enframe(lm(speed ~ ., cars)),
+    error_enframe_must_be_vector(lm(speed ~ ., cars))
   )
 })
 
@@ -106,6 +106,7 @@ test_that("output test", {
   expect_snapshot_with_error({
     enframe(1:3, value = NULL)
 
-    enframe(Titanic)
+    nrow(enframe(Titanic))
+    enframe(Titanic)$value
   })
 })

tests/testthat/test-msg.R

@@ -40,8 +40,7 @@ test_that("output test", {
 
     "#enframe"
     error_enframe_value_null()
-
-    error_enframe_has_dim(Titanic)
+    error_enframe_must_be_vector(lm(speed ~ ., cars))
 
     "# names"
     error_column_names_cannot_be_empty(1, repair_hint = TRUE)

tests/testthat/test-zzz-enframe.R

@@ -62,6 +62,8 @@ test_that("can't use value = NULL", {
 })
 
 test_that("can't pass objects with dimensions", {
+  skip_enh_enframe_vector()
+
   expect_legacy_error(
     enframe(iris),
     error_enframe_has_dim(iris),