rlang:使用nse函数中的冒号快捷方式从…获取名称

我想你要找的功能是 tidyselect::vars_select() ,由select和rename内部使用,以完成此任务。它返回变量名的字符向量。例如:

> tidyselect::vars_select(letters, g:j)
  g   h   i   j 
"g" "h" "i" "j"

这允许您使用所有有效的语法 dplyr::select .

我们可以创建一个 if 这些情况的条件 : ,从中获取列名称(“收集名称”)。 select 用于 fct_relevel

gather_arrange <- function(df, group = variable, ...) {

    gather_cols <-  quos(...)
     grp_var <-  enquo(group)
    if(length(gather_cols)==1 && grepl(":", quo_name(gather_cols[[1]]))) {
         gather_cols <- parse_expr(quo_name(gather_cols[[1]]))
    }

    gather_names <- df %>%
                     select(!!! gather_cols) %>% 
                     names
    df %>%
         gather(key = type, value = value, !!!gather_cols)  %>%
         mutate(!!rlang::quo_name(grp_var) := !!grp_var %>% 
         fct_inorder() %>% 
         fct_rev()) %>%
         mutate(type = as.factor(type) %>%
                       fct_relevel(gather_names)) %>%
         arrange(type)             
    }

-正在检查

out1 <- gather_arrange(df = race, group = variable,
                     estimate, moe, share, sharemoe)
out1
# A tibble: 32 x 4
#   region     variable type      value
#   <chr>      <fct>    <fct>     <dbl>
# 1 New Haven  white    estimate  40164
# 2 New Haven  black    estimate  42970
# 3 New Haven  asian    estimate   6042
# 4 New Haven  latino   estimate  37231
# 5 Outer Ring white    estimate 164150
# 6 Outer Ring black    estimate   3471
# 7 Outer Ring asian    estimate   9565
# 8 Outer Ring latino   estimate   8518
# 9 New Haven  white    moe        1395
#10 New Haven  black    moe        1383
# ... with 22 more rows



out2 <- gather_arrange(df = race, group = variable, estimate:sharemoe)
identical(out1, out2)
#[1] TRUE

更新

如果我们在 ...

gather_arrange2 <- function(df, group = variable, ...) {

    gather_cols <-  quos(...)
    grp_var <-  enquo(group)

    gather_names <- df %>%
                     select(!!! gather_cols) %>% 
                     names
    gather_colsN <- lapply(gather_cols, function(x) parse_expr(quo_name(x)))

    df %>%
         gather(key = type, value = value, !!!gather_colsN)  %>%
         mutate(!!rlang::quo_name(grp_var) := !!grp_var %>% 
         fct_inorder() %>% 
         fct_rev()) %>%
         mutate(type = as.factor(type) %>%
                       fct_relevel(gather_names)) %>%
         arrange(type)             
    }       

-正在检查

out1 <- gather_arrange2(df = race, group = variable,
                 estimate, moe, share, sharemoe, region)
out2 <- gather_arrange2(df = race, group = variable, estimate:sharemoe, region)

identical(out1, out2)
#[1] TRUE

或者只检查一组列

out1 <- gather_arrange2(df = race, group = variable,
                      estimate, moe, share, sharemoe)
out2 <- gather_arrange2(df = race, group = variable, estimate:sharemoe)
identical(out1, out2)
#[1] TRUE

fun <- function(df, ...){
  as.character(substitute(list(...)))[-1] %>% 
    lapply(function(x)
      if(!grepl(':', x)) x
      else strsplit(x, ':')[[1]] %>%
            lapply(match, names(df)) %>%
            {names(df)[do.call(seq, .)]})%>% 
    unlist
}
names(race)
# [1] "region"   "variable" "estimate" "moe"      "share"    "sharemoe"    

fun(race, estimate:sharemoe, region)
# [1] "estimate" "moe"      "share"    "sharemoe" "region"  

fun(race, estimate, moe, share, sharemoe, region)
# [1] "estimate" "moe"      "share"    "sharemoe" "region" 

fun(race, moe, region:variable)
 # [1] "moe"      "region"   "variable"

这涉及到两个方面 : 符号表达式和其他列名称作为参数,例如 fun(race, estimate:sharemoe, region) .

有趣的是,这个黑客解决方案似乎比 tidyselect (并非可变选择可能是整体速度的痛点)

fun <- function(y, ...){
  as.character(substitute(list(...)))[-1] %>% 
    lapply(function(x)
      if(!grepl(':', x)) x
      else strsplit(x, ':')[[1]] %>%
            lapply(match, y) %>%
            {y[do.call(seq, .)]})%>% 
    unlist
}
library(microbenchmark)
microbenchmark(
  tidy = tidyselect::vars_select(letters, b, g:j, a),
  fun  = fun(letters, b, g:j, a), 
  unit = 'relative')
# Unit: relative
#  expr      min       lq     mean   median       uq      max neval
#  tidy 19.90837 18.10964 15.32737 14.28823 13.86212 14.44013   100
#   fun  1.00000  1.00000  1.00000  1.00000  1.00000  1.00000   100

原功能

gather_arrange <- function(df, ..., group = variable) {
  gather_cols <- rlang::quos(...)
  grp_var <- rlang::enquo(group)
  gather_names <- purrr::map_chr(rlang::exprs(...), as.character)

  df %>%
    tidyr::gather(key = type, value = value, !!!gather_cols) %>%
    dplyr::mutate(!!rlang::quo_name(grp_var) := !!grp_var %>% 
                    forcats::fct_inorder() %>% forcats::fct_rev()) %>%
    dplyr::mutate(type = as.factor(type) %>% forcats::fct_relevel(gather_names)) %>%
    arrange(type)
}

使用上述定义的函数 fun :

my_gather_arrange <- function(df, ..., group = variable) {
  gather_cols <- gather_names <- 
    as.character(substitute(list(...)))[-1] %>% 
      lapply(function(x){
        if(grepl(':', x)){
          strsplit(x, ':')[[1]] %>%
            lapply(match, names(df)) %>%
            {names(df)[do.call(seq, .)]}}
        else x}) %>% 
      unlist
  grp_var <- rlang::enquo(group)

  df %>%
    tidyr::gather(key = type, value = value, !!!gather_cols) %>%
    dplyr::mutate(!!rlang::quo_name(grp_var) := !!grp_var %>% 
                    forcats::fct_inorder() %>% forcats::fct_rev()) %>%
    dplyr::mutate(type = as.factor(type) %>% forcats::fct_relevel(gather_names)) %>%
    arrange(type)
}

out1 <- gather_arrange(race, estimate, moe, share, sharemoe, region)
out2 <- my_gather_arrange(race, estimate:sharemoe, region)
#   
identical(out1, out2)
# [1] TRUE