Search code examples
rrlangtidyevalnon-standard-evaluation

Select named [list] element using tidy evaluation


I'm trying to wrap my head around non-standard evaluation as it's interpreted in the rlang package. With that goal in mind, my question is:

How do I write a dplyr::select.list() function that is consistent with tidy evaluation principles?

Here's an example of how I would currently write a wrapper around dplyr::select():

select_wrapper <- function(x, ...) {
  vars <- rlang::quos(...)
  dplyr::select(x, !!!vars)
}

That works on data frames, e.g.,

> select_wrapper(mtcars, cyl, mpg)
> ##                     cyl  mpg
> ## Mazda RX4             6 21.0
> ## Mazda RX4 Wag         6 21.0
> ## Datsun 710            4 22.8
> ## Hornet 4 Drive        6 21.4
> ## Hornet Sportabout     8 18.7
> ## Valiant               6 18.1

But not on lists:

attr(mtcars, "test") <- "asdf"
mtcars_list <- attributes(mtcars)
select_wrapper(mtcars_list, row.names, test)
> ## 1: c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
> ## 2: c("Mazda RX4", "Mazda RX4 Wag", "Datsun 710", "Hornet 4 Drive", "Hornet Sportabout", "Valiant", "Duster 360", "Merc 240D", "Merc 230", "Merc 280", "Merc 280C", "Merc 450SE", "Merc 450SL", "Merc 450SLC", "Cadillac Fleetwood", "Lincoln Continental", "Chrysler Imperial", "Fiat 128", "Honda Civic", "Toyota Corolla", "Toyota Corona", "Dodge Challenger", "AMC Javelin", "Camaro Z28", "Pontiac Firebird", "Fiat X1-9", "Porsche 914-2", "Lotus Europa", "Ford Pantera L", "Ferrari Dino", "Maserati Bora", "Volvo 142E")
> ## 3: data.frame
> ## 4: asdf
> ## Selection: 

To be honest, I'm not sure what's going on in the output above...it returns an interactive prompt asking me to select which element I want. That's not really ideal, imo.

Anyway, what I'd like to accomplish, is a select.list() function that returns a list of the named elements I select via non-standard evaluation. This is my solution, but it feels too hacky:

listdf <- function(x) {
  as.data.frame(lapply(x, function(x) I(list(x))))
}
dflist <- function(x) {
  x <- lapply(x, unlist, recursive = FALSE)
  lapply(x, unclass)
}
select.list <- function(x, ...) {
  dots <- rlang::quos(...)
  if (length(dots) == 0L) return(list())
  x <- listdf(x)
  dflist(dplyr::select(x, !!!dots))
}

library(dplyr)
attr(mtcars, "test") <- "asdf"

select(attributes(mtcars), test, row.names)

Is there a cleaner and more tidy-eval consistent way to do this?


Solution

  • You can use tidyselect which implements the backend for select():

    select2 <- function(.x, ...) {
      vars <- rlang::names2(.x)
      vars <- tidyselect::vars_select(vars, ...)
      .x[vars]
    }
    
    x <- list(a = 1, b = 2)
    select2(x, dplyr::starts_with("a"))
    

    Note that it's bad practice to implement an S3 method when you don't own either the generic (e.g. select() owned by dplyr) or the class (e.g. list from R core).