diff --git a/NAMESPACE b/NAMESPACE index c86b53647..9a60da1c1 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/enframe.R b/R/enframe.R index 5929297eb..e7a040090 100644 --- a/R/enframe.R +++ b/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]], "." + )) } diff --git a/R/tibble-package.R b/R/tibble-package.R index 0c36a6bad..94f6708cf 100644 --- a/R/tibble-package.R +++ b/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")` diff --git a/tests/testthat/_snaps/enframe.md b/tests/testthat/_snaps/enframe.md index 60f3ef2c2..0d39acfe6 100644 --- a/tests/testthat/_snaps/enframe.md +++ b/tests/testthat/_snaps/enframe.md @@ -5,7 +5,46 @@ Error `value` can't be NULL. Code - enframe(Titanic) - Error - `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 + diff --git a/tests/testthat/_snaps/msg.md b/tests/testthat/_snaps/msg.md index fbb2f0e5e..703bed590 100644 --- a/tests/testthat/_snaps/msg.md +++ b/tests/testthat/_snaps/msg.md @@ -118,10 +118,10 @@ `value` can't be NULL. Code - error_enframe_has_dim(Titanic) + error_enframe_must_be_vector(lm(speed ~ ., cars)) Output - - `x` must not have more than one dimension. `length(dim(x))` must be zero or one, not 4. + + The `x` argument to `enframe()` must be a vector, not lm. Code # # names error_column_names_cannot_be_empty(1, repair_hint = TRUE) diff --git a/tests/testthat/helper-zzz.R b/tests/testthat/helper-zzz.R index 336e53e0e..9a6b177ad 100644 --- a/tests/testthat/helper-zzz.R +++ b/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() diff --git a/tests/testthat/test-enframe.R b/tests/testthat/test-enframe.R index c29c6ec41..f4b1c86e5 100644 --- a/tests/testthat/test-enframe.R +++ b/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 }) }) diff --git a/tests/testthat/test-msg.R b/tests/testthat/test-msg.R index c04b44c5b..bddb59800 100644 --- a/tests/testthat/test-msg.R +++ b/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) diff --git a/tests/testthat/test-zzz-enframe.R b/tests/testthat/test-zzz-enframe.R index fc6bec943..f372f23e6 100644 --- a/tests/testthat/test-zzz-enframe.R +++ b/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),