Merge pull request #393 from tidyverse/tidyselect-1.2.0

tidyselect v1.2.0 updates
tidyverse · Oct 17, 2022 · 55e9298 · 55e9298
2 parents 8af4b33 + 4e523de
commit 55e9298
Show file tree

Hide file tree

Showing 20 changed files with 56 additions and 120 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -25,7 +25,7 @@ Imports:
     lifecycle,
     rlang (>= 1.0.4),
     tibble,
-    tidyselect (>= 1.1.2.9000),
+    tidyselect (>= 1.2.0),
     vctrs (>= 0.4.1)
 Suggests:
     bench,
@@ -35,12 +35,10 @@ Suggests:
     testthat (>= 3.1.2),
     tidyr (>= 1.1.0),
     waldo (>= 0.3.1)
-Remotes:
-    r-lib/tidyselect
 VignetteBuilder: 
     knitr
 Config/Needs/website: tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: {library(tidyr); list(markdown = TRUE)}
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1
diff --git a/NAMESPACE b/NAMESPACE
@@ -66,6 +66,8 @@ S3method(tail,dtplyr_step)
 S3method(tally,dtplyr_step)
 S3method(tbl_vars,dtplyr_step)
 S3method(tbl_vars,foo)
+S3method(tidyselect_data_has_predicates,dtplyr_step)
+S3method(tidyselect_data_proxy,dtplyr_step)
 S3method(transmute,dtplyr_step)
 S3method(ungroup,dtplyr_step)
 S3method(union_all,dtplyr_step)
@@ -128,5 +130,7 @@ importFrom(glue,glue)
 importFrom(lifecycle,deprecated)
 importFrom(tibble,as_tibble)
 importFrom(tidyselect,everything)
+importFrom(tidyselect,tidyselect_data_has_predicates)
+importFrom(tidyselect,tidyselect_data_proxy)
 importFrom(utils,head)
 importFrom(utils,tail)
diff --git a/R/step-call-pivot_longer.R b/R/step-call-pivot_longer.R
@@ -77,7 +77,7 @@ pivot_longer.dtplyr_step <- function(data,
     abort("`values_transform` is not supported by dtplyr")
   }
 
-  measure_vars <- names(dtplyr_tidyselect(data, {{ cols }}))
+  measure_vars <- names(tidyselect::eval_select(enquo(cols), data))
   if (length(measure_vars) == 0) {
     abort("`cols` must select at least one column.")
   }

diff --git a/R/step-call-pivot_wider.R b/R/step-call-pivot_wider.R
@@ -56,14 +56,14 @@ pivot_wider.dtplyr_step <- function(data,
                                     values_fill = NULL,
                                     values_fn = NULL,
                                     ...) {
-  names_from <- names(dtplyr_tidyselect(data, {{ names_from }}))
-  values_from <- names(dtplyr_tidyselect(data, {{ values_from}}))
+  names_from <- names(tidyselect::eval_select(enquo(names_from), data))
+  values_from <- names(tidyselect::eval_select(enquo(values_from), data))
 
   id_cols <- enquo(id_cols)
   if (quo_is_null(id_cols)) {
     id_cols <- setdiff(data$vars, c(names_from, values_from))
   } else {
-    id_cols <- names(dtplyr_tidyselect(data, !!id_cols))
+    id_cols <- names(tidyselect::eval_select(id_cols, data))
   }
 
   if (length(names_from) > 1) {

diff --git a/R/step-call.R b/R/step-call.R
@@ -71,8 +71,7 @@ tail.dtplyr_step <- function(x, n = 6L, ...) {
 #' dt %>% rename(new_x = x, new_y = y)
 #' dt %>% rename_with(toupper)
 rename.dtplyr_step <- function(.data, ...) {
-  sim_data <- simulate_vars(.data)
-  locs <- tidyselect::eval_rename(expr(c(...)), sim_data)
+  locs <- tidyselect::eval_rename(expr(c(...)), .data)
 
   step_setnames(.data, .data$vars[locs], names(locs), in_place = TRUE, rename_groups = TRUE)
 }
@@ -109,7 +108,7 @@ rename_with.dtplyr_step <- function(.data, .fn, .cols = everything(), ...) {
   # But this should be fast, so doing it twice shouldn't matter
   .fn <- as_function(.fn)
 
-  locs <- unname(dtplyr_tidyselect(.data, {{ .cols }}))
+  locs <- unname(tidyselect::eval_select(enquo(.cols), .data))
   old_vars <- .data$vars[locs]
   new_vars <- .fn(old_vars)
 
@@ -215,7 +214,7 @@ unique.dtplyr_step <- function(x, incomparables = FALSE, ...) {
 #' dt %>% drop_na(x, any_of(vars))
 # exported onLoad
 drop_na.dtplyr_step <- function(data, ...) {
-  locs <- names(dtplyr_tidyselect(data, ...))
+  locs <- names(tidyselect::eval_select(expr(c(...)), data))
 
   args <- list()
   if (length(locs) > 0) {

diff --git a/R/step-colorder-relocate.R b/R/step-colorder-relocate.R
@@ -16,39 +16,14 @@
 #' dt %>% relocate(y, .before = x)
 #' dt %>% relocate(y, .after = y)
 relocate.dtplyr_step <- function(.data, ..., .before = NULL, .after = NULL) {
-  to_move <- dtplyr_tidyselect(.data, ...)
-
-  if (length(to_move) == 0) {
-    return(.data)
-  }
-
-  .before <- enquo(.before)
-  .after <- enquo(.after)
-  has_before <- !quo_is_null(.before)
-  has_after <- !quo_is_null(.after)
-
-  if (has_before && has_after) {
-    abort("Must supply only one of `.before` and `.after`.")
-  } else if (has_before) {
-    where <- min(unname(dtplyr_tidyselect(.data, !!.before)))
-    if (!where %in% to_move) {
-      to_move <- c(to_move, where)
-    }
-  } else if (has_after) {
-    where <- max(unname(dtplyr_tidyselect(.data, !!.after)))
-    if (!where %in% to_move) {
-      to_move <- c(where, to_move)
-    }
-  } else {
-    where <- 1L
-    if (!where %in% to_move) {
-      to_move <- union(to_move, where)
-    }
-  }
-
-  lhs <- setdiff(seq2(1, where - 1), to_move)
-  rhs <- setdiff(seq2(where + 1, ncol(.data)), to_move)
-  new_vars <- .data$vars[unique(c(lhs, to_move, rhs))]
+  new_vars <- names(tidyselect::eval_relocate(
+    expr(c(...)),
+    .data,
+    before = enquo(.before),
+    after = enquo(.after),
+    before_arg = ".before",
+    after_arg = ".after"
+  ))
   out <- step_colorder(.data, new_vars)
   step_group(out, .data$groups)
 }
diff --git a/R/step-nest.R b/R/step-nest.R
@@ -75,6 +75,6 @@ eval_nest_dots <- function(.data, ...) {
     list(data = nest_vars)
   } else {
     cols <- enquos(...)
-    lapply(cols, function(.x) names(dtplyr_tidyselect(.data, !!.x)))
+    lapply(cols, function(.x) names(tidyselect::eval_select(.x, .data)))
   }
 }
diff --git a/R/step-subset-select.R b/R/step-subset-select.R
@@ -17,7 +17,7 @@
 #' dt %>% select(ends_with("2"))
 #' dt %>% select(z1 = x1, z2 = x2)
 select.dtplyr_step <- function(.data, ...) {
-  locs <- dtplyr_tidyselect(.data, ...)
+  locs <- tidyselect::eval_select(expr(c(...)), .data)
   locs <- ensure_group_vars(locs, .data$vars, .data$groups)
 
   vars <- set_names(.data$vars[locs], names(locs))
@@ -52,37 +52,16 @@ select.dtplyr_step <- function(.data, ...) {
   step_group(out, groups)
 }
 
-dtplyr_tidyselect <- function(.data, ...,
-                              .call = caller_env(),
-                              .allow_rename = TRUE,
-                              .drop_groups = FALSE) {
-  dots <- enquos(...)
-  if (selection_uses_where(dots)) {
-    abort("The use of `where()` is not supported by dtplyr.", call = .call)
-  }
-  sim_data <- simulate_vars(.data, drop_groups = .drop_groups)
-  tidyselect::eval_select(
-    expr(c(!!!dots)),
-    sim_data,
-    allow_rename = .allow_rename,
-    error_call = .call
-  )
-}
-
-selection_uses_where <- function(x) {
-  is_predicate <- unlist(lapply(x, dot_uses_where))
-  any(is_predicate)
+#' @importFrom tidyselect tidyselect_data_proxy
+#' @exportS3Method
+tidyselect_data_proxy.dtplyr_step <- function(x) {
+  simulate_vars(x)
 }
 
-dot_uses_where <- function(x) {
-  x <- quo_squash(x)
-  if (is_call(x, "where")) {
-    TRUE
-  } else if (is_symbol(x) || is_atomic(x)) {
-    FALSE
-  } else {
-    lapply(x[-1], dot_uses_where)
-  }
+#' @importFrom tidyselect tidyselect_data_has_predicates
+#' @exportS3Method
+tidyselect_data_has_predicates.dtplyr_step <- function(x) {
+  FALSE
 }
 
 simulate_vars <- function(x, drop_groups = FALSE) {

diff --git a/R/tidyeval-across.R b/R/tidyeval-across.R
@@ -90,15 +90,14 @@ across_setup <- function(data,
                          fn) {
   .cols <- call$.cols %||% expr(everything())
   .cols <- as_quosure(.cols, env)
-  locs <- dtplyr_tidyselect(
-    data,
-    !!.cols,
-    .call = call2(fn),
-    .allow_rename = allow_rename,
-    .drop_groups = TRUE
+  tbl <- simulate_vars(data, drop_groups = TRUE)
+  locs <- tidyselect::eval_select(
+    .cols,
+    lazy_dt(tbl),
+    error_call = call2(fn),
+    allow_rename = allow_rename
   )
 
-  tbl <- simulate_vars(data, drop_groups = TRUE)
   vars <- syms(names(tbl))[locs]
   if (allow_rename) {
     names_vars <- names(locs)

diff --git a/R/unite.R b/R/unite.R
@@ -30,7 +30,7 @@ unite.dtplyr_step <- function(data, col, ..., sep = "_", remove = TRUE, na.rm =
     .cols <- data$vars
     locs <- seq_along(.cols)
   } else {
-    locs <- dtplyr_tidyselect(data, !!!dots, .allow_rename = FALSE)
+    locs <- tidyselect::eval_select(expr(c(!!!dots)), data, allow_rename = FALSE)
     .cols <- data$vars[locs]
   }
 

diff --git a/man/dtplyr-package.Rd b/man/dtplyr-package.Rd
diff --git a/man/pivot_longer.dtplyr_step.Rd b/man/pivot_longer.dtplyr_step.Rd
diff --git a/man/pivot_wider.dtplyr_step.Rd b/man/pivot_wider.dtplyr_step.Rd
diff --git a/man/relocate.dtplyr_step.Rd b/man/relocate.dtplyr_step.Rd
diff --git a/man/unite.dtplyr_step.Rd b/man/unite.dtplyr_step.Rd
diff --git a/tests/testthat/_snaps/step-call.md b/tests/testthat/_snaps/step-call.md
@@ -23,6 +23,6 @@
       collect(drop_na(dt, "z"))
     Condition
       Error in `drop_na()`:
-      ! Can't select columns that don't exist.
+      ! Can't subset columns that don't exist.
       x Column `z` doesn't exist.
 
diff --git a/tests/testthat/_snaps/step-colorder-relocate.md b/tests/testthat/_snaps/step-colorder-relocate.md
@@ -0,0 +1,8 @@
+# can only supply one of .before and .after
+
+    Code
+      relocate(dt, y, .before = x, .after = x)
+    Condition
+      Error in `relocate()`:
+      ! Can't supply both `.before` and `.after`.
+
diff --git a/tests/testthat/_snaps/step-group.md b/tests/testthat/_snaps/step-group.md
@@ -5,5 +5,5 @@
     Condition
       Warning:
       The `add` argument of `group_by()` is deprecated as of dplyr 1.0.0.
-      Please use the `.add` argument instead.
+      i Please use the `.add` argument instead.
 
diff --git a/tests/testthat/_snaps/tidyeval.md b/tests/testthat/_snaps/tidyeval.md
@@ -4,11 +4,11 @@
 
 # errors when `where()` is used, #271/#368
 
-    The use of `where()` is not supported by dtplyr.
+    This tidyselect interface doesn't support predicates.
 
 ---
 
-    The use of `where()` is not supported by dtplyr.
+    This tidyselect interface doesn't support predicates.
 
 # desc() checks the number of arguments
 

diff --git a/tests/testthat/test-step-colorder-relocate.R b/tests/testthat/test-step-colorder-relocate.R
@@ -62,7 +62,7 @@ test_that("no .before/.after moves to front", {
 test_that("can only supply one of .before and .after", {
   dt <- lazy_dt(data.table(x = 1, y = 1), "DT")
 
-  expect_error(relocate(dt, y, .before = x, .after = x), "only one")
+  expect_snapshot(relocate(dt, y, .before = x, .after = x), error = TRUE)
 })
 
 test_that("relocate() respects order specified by ...", {