R quo_name equivalent of quos

问题:

Hi following Programming with dplyr I noticed that one can add a name using quo_name. I was wondering how to do this for multiple columns, eg. like a quos_name of sorts. E.g.:

   my_mutate <- function(df, expr) {
  expr <- enquo(expr)
  mean_name <- paste0("mean_", quo_name(expr))
  sum_name <- paste0("sum_", quo_name(expr))

  mutate(df, 
    !!mean_name := mean(!!expr), 
    !!sum_name := sum(!!expr)
  )
}

becomes

   my_mutate <- function(df, ...) {
  exprs <-quos(...)
  mean_names <- paste0("mean_", quos_name(exprs))
  sum_names <- paste0("sum_", quos_name(exprs))

  mutate(df, 
    !!!mean_names := mean(!!!exprs), 
    !!!sum_names := sum(!!!exprs)
  )
}

ie. adding the mean and sum columns for all columns specified in ... , of course this is only as an example and quos_names don't exist. It would be very helpful if there is a way of doing this.

I know it is possible to do something like this in data.table DT[,(Col_names):=lapply(Cols,mean)] for instance (This code does not work, but I have done something like this before).

回答1:

DISCLAIMER: While mutate_at proposed by @aosmith is in my opinion the best and simplest solution, I think it might be instructive to see how the problem could be approached using rlang tools, if mutate_at didn't exist. For science!

As mentioned in the comments, you will want to look into purrr::map() family of functions. You will also run into a separate problem with !!!mean_names := mean(!!!exprs) because the !!! splice operator cannot be used on the left hand of the assignment.

The best rlang approach is to compose your mutate expressions as a named list. Use quo to perform expression arithmetic and stringr::str_c (or paste0 as you've been doing) for string arithmetic:

library( tidyverse )

my_mutate <- function(df, ...) {
  exprs <- enquos(...)

  mean_exprs <- set_names(
    map(exprs, ~quo(mean(!!.x))),               # mpg becomes mean(mpg)
    str_c("mean_", map_chr(exprs, quo_name)) )  # mpg becomes "mean_mpg"

  sum_exprs <- set_names(
    map(exprs, ~quo(sum(!!.x))),                # mpg becomes sum(mpg)
    str_c("sum_", map_chr(exprs, quo_name)) )   # mpg becomes "sum_mpg"

  mutate(df, !!!mean_exprs, !!!sum_exprs)
}

mtcars %>% my_mutate( mpg, cyl )
#    mpg cyl disp  hp ... mean_mpg mean_cyl sum_mpg sum_cyl
# 1 21.0   6  160 110 ... 20.09062   6.1875   642.9     198
# 2 21.0   6  160 110 ... 20.09062   6.1875   642.9     198
# 3 22.8   4  108  93 ... 20.09062   6.1875   642.9     198
# 4 21.4   6  258 110 ... 20.09062   6.1875   642.9     198

---

BONUS: You will notice that we are repeating a chunk of code in our definition of expressions above. We can pull that out into a standalone function that automatically constructs expressions with the provided function and names those expressions accordingly:

mutator <- function(f, ...) {
  f_expr <- enquo(f)
  exprs <- enquos(...)

  ## Same code as in my_mutate above, but with an arbitrary function
  set_names(
    map( exprs, ~quo((!!f_expr)(!!.x)) ),
    str_c( quo_name(f_expr), "_", map_chr(exprs, quo_name) )
  )
}

## Example usage
mutator( sd, mpg, cyl )
# $sd_mpg
# <quosure>
#   expr: ^^sd(^mpg)
#   env:  0x555e05260020

# $sd_cyl
# <quosure>
#   expr: ^^sd(^cyl)
#   env:  0x555e05273af8

We can now use the new mutator function to re-define my_mutate as a simple one-liner:

my_mutate2 <- function(df, ...) {
  mutate( df, !!!mutator(mean, ...), !!!mutator(sum, ...) )
}

回答2:

It seems that you found an answer using mutate_at, but in case you need to do that in another context, I'll add the following way.

If you use the following function, you'll see that quos(...) returns a list of quosures corresponding to your arguments.

watch_quos <- function(...){
    quos_args <- quos(...)
    return(quos_args)
}  
# Returns a list of closures
watch_quos(hello, iam, several, arguments)

So you can easily convert the result of quos to a list (or vector) of characters applying quo_name to each quoted arguments using one of sapply or lapply :

quo_names <- function(...) {
   quos_args <- quos(...)
   char_args <- lapply(quos_args, quo_name)
   return(char_args)
}
# Returns a character list
quo_names(hello, iwill, be, char, arguments)