Ensure grouped_df methods drop grouping vars when needed

Fixes tidyverse#159. Fixes tidyverse#177.

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).
 

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)
 }

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)
 }

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 -------------------------------------------------

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)
 }
 
 

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) {

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)
 }
+

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)
 }

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

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)
+})

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)
+})

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))
 })