Dplyr: Подавать формулы в summarize () как объекты

Созданный на 25 апр. 2018 · 4Комментарии · Источник: tidyverse/dplyr

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

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

Вот пример того, что я имею в виду:

price_per_carat <- ~ sum(price) / sum(carat)
price_depth_ratio <- ~ sum(price) / sum(depth)

summarise_as <- function(.data, ...) {
  # some kind of black magic
}

diamonds %>%
  group_by(cut, clarity)
  summarise_as(price_per_carat, price_depth_ratio)

# A tibble: 40 x 4
# Groups:   cut [?]
     cut clarity price_per_carat price_depth_ratio
   <ord>   <ord>           <dbl>             <dbl>
 1  Fair      I1        2721.185          56.37119
 2  Fair     SI2        4297.840          80.31302
 3  Fair     SI1        4362.573          65.84666
 4  Fair     VS2        4715.875          65.60159
 5  Fair     VS1        4734.064          66.17081
 6  Fair    VVS2        4843.546          53.29967
 7  Fair    VVS1        5824.159          64.07653
 8  Fair      IF        4030.679          31.83685
 9  Good      I1        2989.670          57.94697
10  Good     SI2        4424.404          73.58696
# ... with 30 more rows

Если это не совсем понятно, я в основном пытаюсь найти способ заставить summarise_as(price_per_carat, price_depth_ratio) вести себя так, как я набрал summarise(price_per_carat = sum(price) / sum(carat), price_depth_ratio = sum(price) / sum(depth)) .

Я пробовал всевозможные формы quo (), enquo (), as.formula, deparse (substitute ()) и т.д., чтобы попытаться заставить его работать, и все они потерпели неудачу. Как правильно это сделать?

Источник

Prometheus77

Самый полезный комментарий

Может так проще:

library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, %||%, as_function, flatten, flatten_chr, flatten_dbl,
#>     flatten_int, flatten_lgl, invoke, list_along, modify, prepend,
#>     rep_along, splice

exprs <- list( 
  price_per_carat = expr(sum(price) / sum(carat)), 
  price_depth_ratio = expr(sum(price) / sum(depth))
)

diamonds %>%
  group_by(cut, clarity) %>%
  summarise(!!!exprs)
#> # A tibble: 40 x 4
#> # Groups:   cut [?]
#>    cut   clarity price_per_carat price_depth_ratio
#>    <ord> <ord>             <dbl>             <dbl>
#>  1 Fair  I1                2721.              56.4
#>  2 Fair  SI2               4298.              80.3
#>  3 Fair  SI1               4363.              65.8
#>  4 Fair  VS2               4716.              65.6
#>  5 Fair  VS1               4734.              66.2
#>  6 Fair  VVS2              4844.              53.3
#>  7 Fair  VVS1              5824.              64.1
#>  8 Fair  IF                4031.              31.8
#>  9 Good  I1                2990.              57.9
#> 10 Good  SI2               4424.              73.6
#> # ... with 30 more rows

Создано 25.04.2018 пакетом REPEX (v0.2.0).

romainfrancois 25 апр. 2018

👍2

Все 4 Комментарий

Если вы хотите использовать формулы, вот один из способов:

library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, %||%, as_function, flatten, flatten_chr, flatten_dbl,
#>     flatten_int, flatten_lgl, invoke, list_along, modify, prepend,
#>     rep_along, splice

summarise_as <- function(.data, ...) {
  dots  <- quos(...)
  names <- map_chr(dots, ~as.character(quo_get_expr(.x)))
  names(dots) <- names

  get_expr <- function(q){
    formula <- eval_tidy(quo_get_expr(q), quo_get_env(q))
    expr(!!formula[[2]])
  }

  exprs <- map( dots, get_expr)
  summarise(.data, !!!exprs)
}

price_per_carat <- ~ sum(price) / sum(carat)
price_depth_ratio <- ~ sum(price) / sum(depth)

diamonds %>%
  group_by(cut, clarity) %>%
  summarise_as(price_per_carat, price_depth_ratio)
#> # A tibble: 40 x 4
#> # Groups:   cut [?]
#>    cut   clarity price_per_carat price_depth_ratio
#>    <ord> <ord>             <dbl>             <dbl>
#>  1 Fair  I1                2721.              56.4
#>  2 Fair  SI2               4298.              80.3
#>  3 Fair  SI1               4363.              65.8
#>  4 Fair  VS2               4716.              65.6
#>  5 Fair  VS1               4734.              66.2
#>  6 Fair  VVS2              4844.              53.3
#>  7 Fair  VVS1              5824.              64.1
#>  8 Fair  IF                4031.              31.8
#>  9 Good  I1                2990.              57.9
#> 10 Good  SI2               4424.              73.6
#> # ... with 30 more rows

возможно, у @ lionel- есть подход получше

romainfrancois 25 апр. 2018

👍1

Может так проще:

library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, %||%, as_function, flatten, flatten_chr, flatten_dbl,
#>     flatten_int, flatten_lgl, invoke, list_along, modify, prepend,
#>     rep_along, splice

exprs <- list( 
  price_per_carat = expr(sum(price) / sum(carat)), 
  price_depth_ratio = expr(sum(price) / sum(depth))
)

diamonds %>%
  group_by(cut, clarity) %>%
  summarise(!!!exprs)
#> # A tibble: 40 x 4
#> # Groups:   cut [?]
#>    cut   clarity price_per_carat price_depth_ratio
#>    <ord> <ord>             <dbl>             <dbl>
#>  1 Fair  I1                2721.              56.4
#>  2 Fair  SI2               4298.              80.3
#>  3 Fair  SI1               4363.              65.8
#>  4 Fair  VS2               4716.              65.6
#>  5 Fair  VS1               4734.              66.2
#>  6 Fair  VVS2              4844.              53.3
#>  7 Fair  VVS1              5824.              64.1
#>  8 Fair  IF                4031.              31.8
#>  9 Good  I1                2990.              57.9
#> 10 Good  SI2               4424.              73.6
#> # ... with 30 more rows

Создано 25.04.2018 пакетом REPEX (v0.2.0).

romainfrancois 25 апр. 2018

👍2

Я закрою это сейчас. Возможно, рассмотрите https://community.rstudio.com то, что является скорее вопросами, чем проблемами.

romainfrancois 25 апр. 2018

Этот старый выпуск был автоматически заблокирован. Если вы считаете, что обнаружили связанную проблему, сообщите о новой проблеме (с помощью REPEX) и укажите ссылку на нее. https://prex.tidyverse.org/