R: цикл по пользовательской функции dplyr - PullRequest
1 голос
/ 18 марта 2019

Я хочу создать собственную функцию dplyr и идеально перебрать ее с помощью purrr :: map, чтобы остаться в поле зрения.

Чтобы все было как можно проще, я повторю свою проблему, используя очень простую функцию суммирования.

При сборке пользовательских функций с помощью dplyr я столкнулся с проблемой нестандартной оценки (NSE).Я нашел три разных способа борьбы с этим.Каждый способ работы с NSE прекрасно работает, когда функция вызывается напрямую, но не при ее циклическом выполнении.Ниже вы найдете код, чтобы повторить мою проблему.Каков будет правильный способ заставить мою функцию работать с purrr :: map?

    # loading libraries
    library(dplyr)
    library(tidyr)
    library(purrr)

    # generate test data
    test_tbl <- rbind(tibble(group = rep(sample(letters[1:4], 150, TRUE), each = 4),
                             score = sample(0:10, size = 600, replace = TRUE)),

                      tibble(group = rep(sample(letters[5:7], 50, TRUE), each = 3),
                             score = sample(0:10, size = 150, replace = TRUE))
    )




    # generate two variables to loop over
    test_tbl$group2 <- test_tbl$group
    vars <- c("group", "group2")


    # summarise function 1 using enquo()
    sum_tbl1 <- function(df, x) {

        x <- dplyr::enquo(x)

        df %>%
            dplyr::group_by(!! x) %>%
            dplyr::summarise(score = mean(score, na.rm =TRUE),
                             n = dplyr::n())

    }

    # summarise function 2 using .dots = lazyeval
    sum_tbl2 <- function(df, x) {

        df %>%
            dplyr::group_by_(.dots = lazyeval::lazy(x)) %>%
            dplyr::summarize(score = mean(score, na.rm =TRUE),
                             n = dplyr::n())

    }

    # summarise function 3 using ensym()
    sum_tbl3 <- function(df, x) {

        df %>%
            dplyr::group_by(!!rlang::ensym(x)) %>%
            dplyr::summarize(score = mean(score, na.rm =TRUE),
                             n = dplyr::n())

    }


    # Looping over the functions with map
    # each variation produces an error no matter which function I choose

    # call within anonymous function without pipe
    map(vars, function(x) sum_tbl1(test_tbl, x))
    map(vars, function(x) sum_tbl2(test_tbl, x))
    map(vars, function(x) sum_tbl3(test_tbl, x))

    # call within anonymous function witin pipe
    map(vars, function(x) test_tbl %>% sum_tbl1(x))
    map(vars, function(x) test_tbl %>% sum_tbl2(x))
    map(vars, function(x) test_tbl %>% sum_tbl3(x))

    # call with formular notation without pipe
    map(vars, ~sum_tbl1(test_tbl, .x))
    map(vars, ~sum_tbl2(test_tbl, .x))
    map(vars, ~sum_tbl3(test_tbl, .x))

    # call with formular notation within pipe
    map(vars,  ~test_tbl %>% sum_tbl1(.x))
    map(vars,  ~test_tbl %>% sum_tbl2(.x))
    map(vars,  ~test_tbl %>% sum_tbl3(.x))

Я знаю, что существуют другие решения для создания сводных таблиц в цикле, такие как непосредственный вызов map и создание анонимной функции.внутри карты (см. код ниже).Однако проблема, которая меня интересует, заключается в том, как в целом работать с NSE в циклах.

# One possibility to create summarize tables in loops with map
 vars %>%
    map(function(x){
        test_tbl %>%
            dplyr::group_by(!!rlang::ensym(x)) %>%
            dplyr::summarize(score = mean(score, na.rm =TRUE),
                             n = dplyr::n())
    })

Обновление:

Ниже akrun предлагает решение, которое делает вызов через purrr :: map() возможный.Однако прямой вызов функции возможен только при вызове группирующей переменной в виде строки либо непосредственно

sum_tbl(test_tbl, “group”)

, либо косвенно как

sum_tbl(test_tbl, vars[1])

. В этом решении невозможновызовите группирующую переменную обычным способом dplyr как

sum_tbl(test_tbl, group)

В конце концов, мне кажется, что решения NSE в пользовательских функциях dpylr могут решить проблему либо на уровне самого вызова функции, а затем с помощью map/ lapply невозможен, или NSE может быть адресована для работы с итерациями, тогда переменные могут быть вызваны только как «строки».

Опираясь на ответ akruns, я создал обходную функцию, которая позволяет использовать как строки, так и обычные имена переменных в вызове функции.Тем не менее, есть определенно лучшие способы сделать это возможным.В идеале, существует более простой способ работы с NSE в пользовательских функциях dplyr, так что обходной путь, такой как приведенный ниже, не является необходимым в первую очередь.

sum_tbl <- function(df, x) {

        x_var <- dplyr::enquo(x)

        x_env <- rlang::get_env(x_var)

        if(identical(x_env,empty_env())) {

            # works, when x is a string and in loops via map/lapply
            sum_tbl <- df %>%
                dplyr::group_by(!! rlang::sym(x)) %>%
                dplyr::summarise(score = mean(score, na.rm = TRUE),
                                 n = dplyr::n())

        } else {
            # works, when x is a normal variable name without quotation marks
            x = dplyr::enquo(x)

            sum_tbl <- df %>%
                dplyr::group_by(!! x) %>%
                dplyr::summarise(score = mean(score, na.rm = TRUE),
                                 n = dplyr::n())
        }

        return(sum_tbl)
    }

Окончательное обновление / решение

В обновленной версии своего ответа akrun предлагает решение, которое учитывает четыре способа вызова переменной x:

  1. как обычное (не строковое) имя переменной: sum_tbl(test_tbl, group)
  2. как строковое имя: sum_tbl(test_tbl, "group")
  3. как индексированный вектор: sum_tbl(test_tbl, !!vars[1])
  4. и как вектор внутри purr::map(): map(vars, ~ sum_tbl(test_tbl, !!.x))

В (3) и (4) необходимо заключить в кавычки переменную x, используя !!.

Если бы я использовал функцию только для себя, это не было бы проблемой,но как только другие члены команды будут использовать функцию, которую мне нужно будет объяснить, задокументируйте функцию.

Чтобы избежать этого, я теперь расширил решение akrun для учета всех четырех способов без кавычек.Однако я не уверен, что это решение создало другие подводные камни.

sum_tbl <- function(df, x) {

    # if x is a symbol such as group without strings, than turn it into a string    
    if(is.symbol(get_expr(enquo(x))))  {

        x <- quo_name(enquo(x))

    # if x is a language object such as vars[1], evaluate it
    # (this turns it into a symbol), then turn it into a string
    } else if (is.language(get_expr(enquo(x))))  {

        x <- eval(x)
        x <- quo_name(enquo(x))

    } 

      # this part of the function works with normal strings as x
        sum_tbl <- df %>%
            dplyr::group_by(!! rlang::sym(x)) %>%
            dplyr::summarise(score = mean(score, na.rm = TRUE),
                             n = dplyr::n())

    return(sum_tbl)

}

1 Ответ

1 голос
/ 18 марта 2019

Мы можем просто использовать group_by_at, который может принимать строку в качестве аргумента

sum_tbl1 <- function(df, x) {



            df %>%
                dplyr::group_by_at(x) %>%
                dplyr::summarise(score = mean(score, na.rm =TRUE),
                                 n = dplyr::n())

        }

, а затем позвоните как

out1 <- map(vars, ~ sum_tbl1(test_tbl, .x))

Или другой вариант - преобразовать в sym бол и затем оценить (!!) в пределах group_by

sum_tbl2 <- function(df, x) {



            df %>%
                dplyr::group_by(!! rlang::sym(x)) %>%
                dplyr::summarise(score = mean(score, na.rm =TRUE),
                                 n = dplyr::n())

        }

out2 <- map(vars, ~ sum_tbl2(test_tbl, .x))

identical(out1 , out2)
#[1] TRUE

Если мы укажем один из параметров, нам не нужно будет указывать второй аргумент, поэтому он также может работать без анонимного вызова

map(vars, sum_tbl2, df = test_tbl)

Обновление

Если мы хотим использовать его с условиями, упомянутыми в обновленном сообщении ОП

sum_tbl3 <- function(df, x) {

           x1 <- enquo(x)
           x2 <- quo_name(x1)

            df %>%
                dplyr::group_by_at(x2) %>%
                dplyr::summarise(score = mean(score, na.rm =TRUE),
                                 n = dplyr::n())

        }


sum_tbl3(test_tbl, group)
# A tibble: 7 x 3
#  group score     n
#  <chr> <dbl> <int>
#1 a      5.43   148
#2 b      5.01   144
#3 c      5.35   156
#4 d      5.19   152
#5 e      5.65    72
#6 f      5.31    36
#7 g      5.24    42

sum_tbl3(test_tbl, "group")
# A tibble: 7 x 3
#  group score     n
#  <chr> <dbl> <int>
#1 a      5.43   148
#2 b      5.01   144
#3 c      5.35   156
#4 d      5.19   152
#5 e      5.65    72
#6 f      5.31    36
#7 g      5.24    42

или звонок от 'vars'

sum_tbl3(test_tbl, !!vars[1])
# A tibble: 7 x 3
#  group score     n
#  <chr> <dbl> <int>
#1 a      5.43   148
#2 b      5.01   144
#3 c      5.35   156
#4 d      5.19   152
#5 e      5.65    72
#6 f      5.31    36
#7 g      5.24    42

и с map

map(vars, ~ sum_tbl3(test_tbl, !!.x))
#[[1]]
# A tibble: 7 x 3
#  group score     n
#  <chr> <dbl> <int>
#1 a      5.43   148
#2 b      5.01   144
#3 c      5.35   156
#4 d      5.19   152
#5 e      5.65    72
#6 f      5.31    36
#7 g      5.24    42

#[[2]]
# A tibble: 7 x 3
#  group2 score     n
#  <chr>  <dbl> <int>
#1 a       5.43   148
#2 b       5.01   144
#3 c       5.35   156
#4 d       5.19   152
#5 e       5.65    72
#6 f       5.31    36
#7 g       5.24    42
...