Skip to content

Commit 1c0653d

Browse files
Fix unite() with empty selections (#1570)
* unite works for empty selections fixes #1548 * NEWS bullet * Tweak tests * A little modernization * Bah, whitespace --------- Co-authored-by: Davis Vaughan <[email protected]>
1 parent d3d0deb commit 1c0653d

File tree

3 files changed

+58
-14
lines changed

3 files changed

+58
-14
lines changed

NEWS.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# tidyr (development version)
22

3+
* `unite()` no longer errors if you provide a selection that doesn't select any
4+
columns. Instead, it returns a column containing the empty string (#1548,
5+
@catalamarti).
6+
37
* `pivot_wider_spec()` now throws a more informative error on non-data frame
48
inputs (@catalamarti, #1510).
59

R/unite.R

+26-14
Original file line numberDiff line numberDiff line change
@@ -42,37 +42,49 @@ unite.data.frame <- function(data, col, ..., sep = "_", remove = TRUE, na.rm = F
4242
check_bool(remove)
4343
check_bool(na.rm)
4444

45+
col <- as_string(ensym(col))
46+
col <- enc2utf8(col)
47+
4548
if (dots_n(...) == 0) {
46-
from_vars <- set_names(seq_along(data), names(data))
49+
selection <- set_names(seq_along(data), names(data))
4750
} else {
48-
from_vars <- tidyselect::eval_select(expr(c(...)), data, allow_rename = FALSE)
51+
selection <- tidyselect::eval_select(expr(c(...)), data, allow_rename = FALSE)
4952
}
5053

54+
empty_selection <- length(selection) == 0L
55+
5156
out <- data
5257
if (remove) {
53-
out <- out[setdiff(names(out), names(from_vars))]
58+
out <- out[setdiff(names(out), names(selection))]
5459
}
5560

56-
if (identical(na.rm, TRUE)) {
57-
cols <- unname(map(data[from_vars], as.character))
61+
if (empty_selection) {
62+
# Use initial value implied by the reduction algorithm (#1570)
63+
united <- vec_rep("", times = vec_size(data))
64+
} else if (identical(na.rm, TRUE)) {
65+
cols <- unname(map(data[selection], as.character))
5866
rows <- transpose(cols)
59-
6067
united <- map_chr(rows, function(x) paste0(x[!is.na(x)], collapse = sep))
6168
} else {
62-
cols <- unname(as.list(data[from_vars]))
69+
cols <- unname(as.list(data[selection]))
6370
united <- exec(paste, !!!cols, sep = sep)
6471
}
6572

66-
var <- as_string(ensym(col))
67-
var <- enc2utf8(var)
68-
6973
united <- list(united)
70-
names(united) <- var
74+
names(united) <- col
7175

72-
first_pos <- which(names(data) %in% names(from_vars))[1]
73-
after <- first_pos - 1L
76+
if (empty_selection) {
77+
after <- length(data)
78+
} else {
79+
loc_first_selection <- which(names(data) %in% names(selection))[[1L]]
80+
after <- loc_first_selection - 1L
81+
}
7482

7583
out <- df_append(out, united, after = after)
7684

77-
reconstruct_tibble(data, out, if (remove) names(from_vars))
85+
reconstruct_tibble(
86+
input = data,
87+
output = out,
88+
ungrouped_vars = if (remove) names(selection)
89+
)
7890
}

tests/testthat/test-unite.R

+28
Original file line numberDiff line numberDiff line change
@@ -71,3 +71,31 @@ test_that("validates its inputs", {
7171
unite(df, "z", x:y, na.rm = 1)
7272
})
7373
})
74+
75+
test_that("returns an empty string column for empty selections (#1548)", {
76+
# i.e. it returns the initial value that would be used in a reduction algorithm
77+
78+
x <- tibble(
79+
x = c("x", "y", "z"),
80+
y = c(1, 2, 3)
81+
)
82+
83+
out <- unite(x, "new", all_of(c()))
84+
85+
expect_identical(names(out), c("x", "y", "new"))
86+
expect_identical(out$new, c("", "", ""))
87+
})
88+
89+
test_that("works with 0 column data frames and empty selections (#1570)", {
90+
x <- tibble(.rows = 2L)
91+
92+
# No `...` implies "unite all the columns"
93+
out <- unite(x, "new")
94+
expect_identical(names(out), "new")
95+
expect_identical(out$new, c("", ""))
96+
97+
# Empty selection
98+
out <- unite(x, "new", all_of(names(x)))
99+
expect_identical(names(out), "new")
100+
expect_identical(out$new, c("", ""))
101+
})

0 commit comments

Comments
 (0)