From 3dbcbf743f6fae0ec36ca8055a78358c600d725a Mon Sep 17 00:00:00 2001 From: hadley Date: Mon, 16 May 2016 16:44:46 -0500 Subject: [PATCH] Ensure grouped_df methods drop grouping vars when needed Fixes #159. Fixes #177. --- NEWS.md | 3 +++ R/complete.R | 2 +- R/extract.R | 4 ++-- R/gather.R | 2 +- R/separate.R | 2 +- R/spread.R | 2 +- R/unite.R | 3 ++- R/unnest.R | 2 +- R/utils.R | 11 ++++++----- tests/testthat/test-separate.R | 8 ++++++++ tests/testthat/test-unite.R | 9 +++++++++ tests/testthat/test-unnest.R | 1 + 12 files changed, 36 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index fadb67121..5be831e95 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # tidyr 0.4.1.9000 +* `unite()` and `separate()` now automatically drop removed variables from + grouping (#159, #177). + * `expand()` (and hence `complete()`) preserves the ordered attribute of factors (#165). diff --git a/R/complete.R b/R/complete.R index 8d4eb6adf..0a5425ae3 100644 --- a/R/complete.R +++ b/R/complete.R @@ -60,5 +60,5 @@ complete_.data.frame <- function(data, cols, fill = list(), ...) { #' @export complete_.grouped_df <- function(data, cols, fill = list(), ...) { - dplyr::grouped_df(NextMethod(), dplyr::groups(data)) + regroup(NextMethod(), data) } diff --git a/R/extract.R b/R/extract.R index 9c8da554c..f4ca5cb69 100644 --- a/R/extract.R +++ b/R/extract.R @@ -79,6 +79,6 @@ extract_.tbl_df <- function(data, col, into, regex = "([[:alnum:]]+)", #' @export extract_.grouped_df <- function(data, col, into, regex = "([[:alnum:]]+)", - remove = TRUE, convert = FALSE, ...) { - dplyr::grouped_df(NextMethod(), dplyr::groups(data)) + remove = TRUE, convert = FALSE, ...) { + regroup(NextMethod(), data, if (remove) col) } diff --git a/R/gather.R b/R/gather.R index a48e81c43..80ab39f0e 100644 --- a/R/gather.R +++ b/R/gather.R @@ -134,7 +134,7 @@ gather_.tbl_df <- function(data, key_col, value_col, gather_cols, #' @export gather_.grouped_df <- function(data, key_col, value_col, gather_cols, na.rm = FALSE, convert = FALSE, factor_key = FALSE) { - regroup(data, NextMethod(), gather_cols) + regroup(NextMethod(), data, gather_cols) } # Functions from reshape2 ------------------------------------------------- diff --git a/R/separate.R b/R/separate.R index be0dd16fc..664e8c1ec 100644 --- a/R/separate.R +++ b/R/separate.R @@ -122,7 +122,7 @@ separate_.tbl_df <- function(data, col, into, sep = "[^[:alnum:]]+", separate_.grouped_df <- function(data, col, into, sep = "[^[:alnum:]]+", remove = TRUE, convert = FALSE, extra = "warn", fill = "warn", ...) { - dplyr::grouped_df(NextMethod(), dplyr::groups(data)) + regroup(NextMethod(), data, if (remove) col) } diff --git a/R/spread.R b/R/spread.R index e14090bc2..3bdb37535 100644 --- a/R/spread.R +++ b/R/spread.R @@ -139,7 +139,7 @@ spread_.tbl_df <- function(data, key_col, value_col, fill = NA, #' @export spread_.grouped_df <- function(data, key_col, value_col, fill = NA, convert = FALSE, drop = TRUE) { - regroup(data, NextMethod(), except = c(key_col, value_col)) + regroup(NextMethod(), data, c(key_col, value_col)) } split_labels <- function(df, id, drop = TRUE) { diff --git a/R/unite.R b/R/unite.R index fd0a31cfe..c6486d020 100644 --- a/R/unite.R +++ b/R/unite.R @@ -63,5 +63,6 @@ unite_.tbl_df <- function(data, col, from, sep = "_", remove = TRUE) { #' @export unite_.grouped_df <- function(data, col, from, sep = "_", remove = TRUE) { - dplyr::grouped_df(NextMethod(), dplyr::groups(data)) + regroup(NextMethod(), data, if (remove) from) } + diff --git a/R/unnest.R b/R/unnest.R index 9c3c30c96..8c90bbb07 100644 --- a/R/unnest.R +++ b/R/unnest.R @@ -138,5 +138,5 @@ unnest_.tbl_df <- function(data, unnest_cols, .drop = NA) { #' @export unnest_.grouped_df <- function(data, unnest_cols, .drop = NA) { - dplyr::grouped_df(dplyr::ungroup(data), dplyr::groups(data)) + regroup(unnest_(dplyr::ungroup(data), unnest_cols, .drop = .drop), data) } diff --git a/R/utils.R b/R/utils.R index c56bbafd0..cd190641e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -62,12 +62,13 @@ list_indices <- function(x, max = 20) { `%||%` <- function(x, y) if (length(x) == 0) y else x -regroup <- function(x, y, except) { - group_vars <- vapply(dplyr::groups(x), as.character, character(1)) - group_vars <- setdiff(group_vars, except) - group_vars <- lapply(group_vars, as.name) +regroup <- function(x, y, except = NULL) { + groups <- dplyr::groups(y) + if (!is.null(except)) { + groups <- setdiff(groups, lapply(except, as.name)) + } - dplyr::grouped_df(y, group_vars) + dplyr::grouped_df(x, groups) } # Allows tests to work with either dplyr 0.4 (which ignores value of diff --git a/tests/testthat/test-separate.R b/tests/testthat/test-separate.R index cd252b8ca..738f17b82 100644 --- a/tests/testthat/test-separate.R +++ b/tests/testthat/test-separate.R @@ -64,3 +64,11 @@ test_that("preserves grouping", { expect_equal(class(df), class(rs)) expect_equal(dplyr::groups(df), dplyr::groups(rs)) }) + +test_that("drops grouping when needed", { + df <- dplyr::data_frame(x = "a:b") %>% dplyr::group_by(x) + rs <- df %>% separate(x, c("a", "b")) + + expect_equal(rs$a, "a") + expect_equal(dplyr::groups(rs), NULL) +}) diff --git a/tests/testthat/test-unite.R b/tests/testthat/test-unite.R index fe824f306..bcc734405 100644 --- a/tests/testthat/test-unite.R +++ b/tests/testthat/test-unite.R @@ -25,3 +25,12 @@ test_that("unite preserves grouping", { expect_equal(class(df), class(rs)) expect_equal(dplyr::groups(df), dplyr::groups(rs)) }) + + +test_that("drops grouping when needed", { + df <- dplyr::data_frame(g = 1, x = "a") %>% dplyr::group_by(g) + rs <- df %>% unite(gx, g, x) + + expect_equal(rs$gx, "1_a") + expect_equal(dplyr::groups(rs), NULL) +}) diff --git a/tests/testthat/test-unnest.R b/tests/testthat/test-unnest.R index 24f6bd2b9..db3e87b3c 100644 --- a/tests/testthat/test-unnest.R +++ b/tests/testthat/test-unnest.R @@ -74,6 +74,7 @@ test_that("grouping is preserved", { df <- dplyr::data_frame(g = 1, x = list(1:3)) %>% dplyr::group_by(g) rs <- df %>% unnest(x) + expect_equal(rs$x, 1:3) expect_equal(class(df), class(rs)) expect_equal(dplyr::groups(df), dplyr::groups(rs)) })