$get_used() is relative to $current_vars(), not names(.data) (#5584)

* $get_used() is relative to $current_vars(), not names(.data)

* `mutate()` always keeps grouping variables, unconditional to `.keep=`

closes #5582

* documentation update for mutate(.keep=)

* testthat update

NEWS.md

@@ -7,6 +7,8 @@
 
 * `across()` handles data frames with 0 columns (#5523). 
 
+* `mutate()` always keeps grouping variables, unconditional to `.keep=` (#5582).
+
 # dplyr 1.0.2
 
 * Fixed `across()` issue where data frame columns would mask objects referred to

R/mutate.R

@@ -161,6 +161,8 @@ mutate <- function(.data, ...) {
 #'   * `"unused"` keeps only existing variables **not** used to make new
 #'     variables.
 #'   * `"none"`, only keeps grouping keys (like [transmute()]).
+#'
+#'   Grouping variables are always kept, unconditional to `.keep`.
 #' @param .before,.after \Sexpr[results=rd]{lifecycle::badge("experimental")}
 #'   <[`tidy-select`][dplyr_tidy_select]> Optionally, control where new columns
 #'   should appear (the default is to add to the right hand side). See
@@ -185,12 +187,14 @@ mutate.data.frame <- function(.data, ...,
   if (keep == "all") {
     out
   } else if (keep == "unused") {
-    unused <- c(names(.data)[!attr(cols, "used")])
-    keep <- intersect(names(out), c(unused, names(cols)))
+    used <- attr(cols, "used")
+    unused <- names(used)[!used]
+    keep <- intersect(names(out), c(group_vars(.data), unused, names(cols)))
     dplyr_col_select(out, keep)
   } else if (keep == "used") {
-    used <- names(.data)[attr(cols, "used")]
-    keep <- intersect(names(out), c(used, names(cols)))
+    used <- attr(cols, "used")
+    used <- names(used)[used]
+    keep <- intersect(names(out), c(group_vars(.data), used, names(cols)))
     dplyr_col_select(out, keep)
   } else if (keep == "none") {
     keep <- c(
@@ -383,6 +387,8 @@ mutate_cols <- function(.data, ...) {
 
   is_zap <- map_lgl(new_columns, inherits, "rlang_zap")
   new_columns[is_zap] <- rep(list(NULL), sum(is_zap))
-  attr(new_columns, "used") <- mask$get_used()
+  used <- mask$get_used()
+  names(used) <- mask$current_vars()
+  attr(new_columns, "used") <- used
   new_columns
 }

tests/testthat/test-deprec-combine-errors.txt

@@ -1,6 +1,12 @@
 > combine("a", 1)
+Warning: `combine()` is deprecated as of dplyr 1.0.0.
+Please use `vctrs::vec_c()` instead.
+
 Error: Can't combine `..1` <character> and `..2` <double>.
 
 > combine(factor("a"), 1L)
+Warning: `combine()` is deprecated as of dplyr 1.0.0.
+Please use `vctrs::vec_c()` instead.
+
 Error: Can't combine `..1` <factor<127a2>> and `..2` <integer>.
 

tests/testthat/test-deprec-dbi-errors.txt

@@ -1,8 +1,6 @@
 > src_sqlite(":memory:")
 Warning: `src_sqlite()` is deprecated as of dplyr 1.0.0.
 Please use `tbl()` directly with a database connection
-This warning is displayed once every 8 hours.
-Call `lifecycle::last_warnings()` to see where this warning was generated.
 
 Error: `path` must already exist, unless `create` = TRUE.
 

tests/testthat/test-deprec-funs-errors.txt

@@ -1,10 +1,34 @@
 > funs(function(si) {
 +   mp[si]
 + })
+Warning: `funs()` is deprecated as of dplyr 0.8.0.
+Please use a list of either functions or lambdas: 
+
+  # Simple named list: 
+  list(mean = mean, median = median)
+
+  # Auto named with `tibble::lst()`: 
+  tibble::lst(mean, median)
+
+  # Using lambdas
+  list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
+
 Error: `function(si) {
     mp[si]
 }` must be a function name (quoted or unquoted) or an unquoted call, not `function`.
 
 > funs(~mp[.])
+Warning: `funs()` is deprecated as of dplyr 0.8.0.
+Please use a list of either functions or lambdas: 
+
+  # Simple named list: 
+  list(mean = mean, median = median)
+
+  # Auto named with `tibble::lst()`: 
+  tibble::lst(mean, median)
+
+  # Using lambdas
+  list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
+
 Error: `~mp[.]` must be a function name (quoted or unquoted) or an unquoted call, not `~`.
 

tests/testthat/test-deprec-src-local-errors.txt

@@ -3,9 +3,13 @@ src_local errs with pkg/env
 ===========================
 
 > src_df("base", new.env())
+Warning: `src_local()` is deprecated as of dplyr 1.0.0.
+
 Error: Exactly one of `pkg` and `env` must be non-NULL, not 2.
 
 > src_df()
+Warning: `src_local()` is deprecated as of dplyr 1.0.0.
+
 Error: Exactly one of `pkg` and `env` must be non-NULL, not 0.
 
 
@@ -15,6 +19,8 @@ copy_to
 > env <- new.env(parent = emptyenv())
 > env$x <- 1
 > src_env <- src_df(env = env)
+Warning: `src_local()` is deprecated as of dplyr 1.0.0.
+
 > copy_to(src_env, tibble(x = 1), name = "x")
 Error: object with `name` = `x` must not already exist, unless `overwrite` = TRUE.
 

tests/testthat/test-do-errors.txt

@@ -10,9 +10,13 @@ unnamed elements must return data frames
 Error: Result must be a data frame, not numeric
 
 > df %>% do(1)
+Warning: `progress_estimated()` is deprecated as of dplyr 1.0.0.
+
 Error: Results 1, 2, 3 must be data frames, not numeric
 
 > df %>% do("a")
+Warning: `progress_estimated()` is deprecated as of dplyr 1.0.0.
+
 Error: Results 1, 2, 3 must be data frames, not character
 
 

tests/testthat/test-mutate.r

@@ -354,6 +354,26 @@ test_that("can use .before and .after to control column position", {
   expect_named(mutate(df, x = 1, .after = y), c("x", "y"))
 })
 
+test_that(".keep= always retains grouping variables (#5582)", {
+  df <- tibble(x = 1, y = 2, z = 3) %>% group_by(z)
+  expect_equal(
+    df %>% mutate(a = x + 1, .keep = "none"),
+    tibble(z = 3, a = 2) %>% group_by(z)
+  )
+  expect_equal(
+    df %>% mutate(a = x + 1, .keep = "all"),
+    tibble(x = 1, y = 2, z = 3, a = 2) %>% group_by(z)
+  )
+  expect_equal(
+    df %>% mutate(a = x + 1, .keep = "used"),
+    tibble(x = 1, z = 3, a = 2) %>% group_by(z)
+  )
+  expect_equal(
+    df %>% mutate(a = x + 1, .keep = "unused"),
+    tibble(y = 2, z = 3, a = 2) %>% group_by(z)
+  )
+})
+
 test_that("mutate() preserves the call stack on error (#5308)", {
   foobar <- function() stop("foo")