rlang: получить имена с помощью ярлыка двоеточия в функции NSE

Пишу пакет функций для составления таблиц демографических данных. У меня есть одна функция, сокращенно сокращенная ниже, где мне нужно взять несколько столбцов (...), в которых я буду gather фрейм данных. Хитрость в том, что я хотел бы сохранить имена этих столбцов в порядке, потому что мне нужно будет разместить столбцы в этом порядке после сбора. В данном случае это столбцы estimate, moe, share, sharemoe.

library(tidyverse)
library(rlang)

race <- structure(list(region = c("New Haven", "New Haven", "New Haven", "New Haven", "Outer Ring", "Outer Ring", "Outer Ring", "Outer Ring"), 
    variable = c("white", "black", "asian", "latino", "white", "black", "asian", "latino"), 
    estimate = c(40164, 42970, 6042, 37231, 164150, 3471, 9565, 8518), 
    moe = c(1395, 1383, 697, 1688, 1603, 677, 896, 1052), 
    share = c(0.308, 0.33, 0.046, 0.286, 0.87, 0.018, 0.051, 0.045), 
    sharemoe = c(0.011, 0.011, 0.005, 0.013, 0.008, 0.004, 0.005, 0.006)), 
    class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -8L))

race
#> # A tibble: 8 x 6
#>   region     variable estimate   moe share sharemoe
#>   <chr>      <chr>       <dbl> <dbl> <dbl>    <dbl>
#> 1 New Haven  white       40164  1395 0.308    0.011
#> 2 New Haven  black       42970  1383 0.33     0.011
#> 3 New Haven  asian        6042   697 0.046    0.005
#> 4 New Haven  latino      37231  1688 0.286    0.013
#> 5 Outer Ring white      164150  1603 0.87     0.008
#> 6 Outer Ring black        3471   677 0.018    0.004
#> 7 Outer Ring asian        9565   896 0.051    0.005
#> 8 Outer Ring latino       8518  1052 0.045    0.006

В функции gather_arrange я получаю имена столбцов ... путем сопоставления rlang::exprs(...) и преобразования в символы. Было нелегко заставить эту работу извлекать имена этих столбцов в виде строк, так что это может быть место, которое можно улучшить или переписать. Но это работает так, как я хочу, делая столбец type как фактор с уровнями estimate, moe, share, sharemoe в этом порядке.

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)
}

race %>% gather_arrange(estimate, moe, share, sharemoe)
#> # 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

Но я хотел бы также использовать обозначение двоеточия для выбора столбцов, то есть estimate:sharemoe, чтобы выполнить эквивалент ввода всех этих имен столбцов.

race %>% gather_arrange(estimate:sharemoe)
#> Error: Result 1 is not a length 1 atomic vector

Это не удается, потому что не удается извлечь имена столбцов из rlang::exprs(...). Как я могу получить имена столбцов с такой нотацией? Заранее спасибо!


person camille    schedule 27.05.2018    source источник


Ответы (3)


Я думаю, что вам нужна функция tidyselect::vars_select() , который используется внутри команды select и rename для выполнения этой задачи. Он возвращает символьный вектор имен переменных. Например:

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

Это позволяет использовать тот же синтаксис, что и для dplyr::select.

person Ryan C. Thompson    schedule 28.05.2018
comment
Не могу поверить, что это так просто! - person camille; 30.05.2018
comment
Честно говоря, это просто потому, что кто-то написал целый пакет, инкапсулирующий эту функциональность. - person Ryan C. Thompson; 03.06.2018

Мы могли бы создать if условие для этих случаев с помощью :, получить имена столбцов ('gather_names') из 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
person akrun    schedule 28.05.2018

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
person IceCreamToucan    schedule 27.05.2018