1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
#' Converting vectors to data frames, and vice versa
#'
#' @description
#' `enframe()` converts named atomic vectors or lists to one- or two-column
#' data frames.
#' For a list, the result will be a nested tibble with a column of type `list`.
#' For unnamed vectors, the natural sequence is used as name column.
#'
#' @param x A vector (for `enframe()`) or a data frame with one or two columns
#' (for `deframe()`).
#' @param name,value Names of the columns that store the names and values.
#' If `name` is `NULL`, a one-column tibble is returned; `value` cannot be `NULL`.
#'
#' @return For `enframe()`, a [tibble] with two columns (if `name` is not `NULL`, the default)
#' or one column (otherwise).
#' @export
#'
#' @examples
#' enframe(1:3)
#' enframe(c(a = 5, b = 7))
#' enframe(list(one = 1, two = 2:3, three = 4:6))
enframe <- function(x, name = "name", value = "value") {
if (is.null(value)) {
cnd_signal(error_enframe_value_null())
}
if (is.null(x)) {
x <- logical()
}
# FIXME: Enable again for data frames, add test
if (!vec_is(x) || is.data.frame(x)) {
cnd_signal(error_enframe_must_be_vector(x))
}
if (is.null(name)) {
df <- list(vectbl_set_names(x))
} else if (is.null(vec_names(x))) {
df <- list(seq_len(vec_size(x)), x)
} else {
df <- list(vec_names2(x), vectbl_set_names(x))
}
names(df) <- c(name, value)
new_tibble(df, nrow = vec_size(x))
}
vectbl_set_names <- function(x, names = NULL) {
# Work around https://github.com/r-lib/vctrs/issues/1419
if (inherits(x, "vctrs_rcrd")) {
# A rcrd can't have names?
return(x)
}
vec_set_names(x, names)
}
#' @rdname enframe
#' @description
#' `deframe()` converts two-column data frames to a named vector or list,
#' using the first column as name and the second column as value.
#' If the input has only one column, an unnamed vector is returned.
#' @return For `deframe()`, a vector (named or unnamed).
#' @export
#' @examples
#' deframe(enframe(3:1))
#' deframe(tibble(a = 1:3))
#' deframe(tibble(a = as.list(1:3)))
deframe <- function(x) {
if (length(x) == 1) {
return(x[[1]])
} else if (length(x) != 2) {
warn("`x` must be a one- or two-column data frame in `deframe()`.")
}
value <- x[[2L]]
name <- x[[1L]]
vectbl_set_names(value, as.character(name))
}
error_enframe_value_null <- function() {
tibble_error("`value` can't be NULL.")
}
error_enframe_must_be_vector <- function(x) {
tibble_error(paste0(
"The `x` argument to `enframe()` must be a vector, not ", class(x)[[1]], "."
))
}
|
