Использование функций окна dplyr для вычисления процентили

У меня есть рабочее решение, но я ищу более чистое и понятное решение, которое, возможно, использует некоторые из новых функций окна dplyr.

Используя набор данных mtcars, если я хочу посмотреть на 25-е, 50-е, 75-е процентиля, а среднее и количество миль на галлон ( "миль на галлон" ) на количество цилиндров ( "цил" ), я использую следующее код:

library(dplyr)
library(tidyr)

# load data
data("mtcars")

# Percentiles used in calculation
p <- c(.25,.5,.75)

# old dplyr solution 
mtcars %>% group_by(cyl) %>% 
  do(data.frame(p=p, stats=quantile(.$mpg, probs=p), 
                n = length(.$mpg), avg = mean(.$mpg))) %>%
  spread(p, stats) %>%
  select(1, 4:6, 3, 2)

# note: the select and spread statements are just to get the data into
#       the format in which I'd like to see it, but are not critical

Есть ли способ сделать это более чистым с помощью dplyr, используя некоторые из сводных функций (n_tiles, percent_rank и т.д.)? Чисто, я имею в виду без инструкции "do".

Спасибо

Ответ 1

Если вы готовы использовать purrr::map, вы можете сделать это следующим образом!

library(tidyverse)

mtcars %>%
  tbl_df() %>%
  nest(-cyl) %>%
  mutate(Quantiles = map(data, ~ quantile(.$mpg)),
         Quantiles = map(Quantiles, ~ bind_rows(.) %>% gather())) %>% 
  unnest(Quantiles)

#> # A tibble: 15 x 3
#>      cyl key   value
#>    <dbl> <chr> <dbl>
#>  1     6 0%     17.8
#>  2     6 25%    18.6
#>  3     6 50%    19.7
#>  4     6 75%    21  
#>  5     6 100%   21.4
#>  6     4 0%     21.4
#>  7     4 25%    22.8
#>  8     4 50%    26  
#>  9     4 75%    30.4
#> 10     4 100%   33.9
#> 11     8 0%     10.4
#> 12     8 25%    14.4
#> 13     8 50%    15.2
#> 14     8 75%    16.2
#> 15     8 100%   19.2

^{Создано 2018-11-10 пакетом представлением (v0.2.1)}

В этом подходе есть одна приятная вещь: результат аккуратный, одно наблюдение на строку.

Ответ 2

ОБНОВЛЕНИЕ 2: еще одно обновление, чтобы превратить предыдущую версию enframe summarise() в однострочник с помощью enframe:

library(tidyverse)

mtcars %>% 
  group_by(cyl) %>% 
  summarise(mpg = list(enframe(quantile(mpg, probs=c(0.25,0.5,0.75))))) %>% 
  unnest

    cyl quantiles   mpg
1     4       25% 22.80
2     4       50% 26.00
3     4       75% 30.40
4     6       25% 18.65
5     6       50% 19.70
6     6       75% 21.00
7     8       25% 14.40
8     8       50% 15.20
9     8       75% 16.25

Это можно превратить в более общую функцию, используя tidyeval:

q_by_group = function(data, value.col, ..., probs=seq(0,1,0.25)) {

  value.col=enquo(value.col)
  groups=enquos(...)

  data %>% 
    group_by(!!!groups) %>% 
    summarise(mpg = list(enframe(quantile(!!value.col, probs=probs)))) %>% 
    unnest
}

q_by_group(mtcars, mpg)
q_by_group(mtcars, mpg, cyl)
q_by_group(mtcars, mpg, cyl, vs, probs=c(0.5,0.75))
q_by_group(iris, Petal.Width, Species)

ОБНОВЛЕНИЕ: здесь вариант ответа @JuliaSilge, который использует вложение для получения квантилей, но без использования map. Однако для добавления столбца, в котором перечислены уровни квантилей, требуется дополнительная строка кода, поскольку я не уверен, каким образом (или если это возможно) записать имена квантилей в отдельный столбец непосредственно из вызова quantile,

p = c(0.25,0.5,0.75)

mtcars %>% 
  group_by(cyl) %>% 
  summarise(quantiles = list(sprintf("%1.0f%%", p*100)),
            mpg = list(quantile(mpg, p))) %>% 
  unnest

ОРИГИНАЛЬНЫЙ ОТВЕТ

Здесь подход dplyr который избегает do но требует отдельного вызова quantile для каждого значения квантиля.

mtcars %>% group_by(cyl) %>%
  summarise('25%'=quantile(mpg, probs=0.25),
            '50%'=quantile(mpg, probs=0.5),
            '75%'=quantile(mpg, probs=0.75),
            avg=mean(mpg),
            n=n())

  cyl   25%  50%   75%      avg  n
1   4 22.80 26.0 30.40 26.66364 11
2   6 18.65 19.7 21.00 19.74286  7
3   8 14.40 15.2 16.25 15.10000 14

Было бы лучше, если бы summarise могло возвращать несколько значений одним вызовом quantile, но это кажется открытой проблемой в разработке dplyr.

Ответ 3

Это подход dplyr, который использует функцию tidy() пакета broom, к сожалению, он все еще требует do(), но это намного проще.

library(dplyr)
library(broom)

mtcars %>%
    group_by(cyl) %>%
    do( tidy(t(quantile(.$mpg))) )

который дает:

    cyl   X0.  X25.  X50.  X75. X100.
  (dbl) (dbl) (dbl) (dbl) (dbl) (dbl)
1     4  21.4 22.80  26.0 30.40  33.9
2     6  17.8 18.65  19.7 21.00  21.4
3     8  10.4 14.40  15.2 16.25  19.2

Обратите внимание на использование t(), так как пакет broom не имеет метода для именованных чисел.

Это основано на моем предыдущем ответе для сводки() здесь.

Ответ 4

Не знаете, как избежать do() в dplyr, но вы можете сделать это с помощью c() и as.list() с помощью data.table довольно простым способом:

require(data.table) 
as.data.table(mtcars)[, c(as.list(quantile(mpg, probs=p)), 
                        avg=mean(mpg), n=.N), by=cyl]
#    cyl   25%  50%   75%      avg  n
# 1:   6 18.65 19.7 21.00 19.74286  7
# 2:   4 22.80 26.0 30.40 26.66364 11
# 3:   8 14.40 15.2 16.25 15.10000 14

Замените by на keyby, если вы хотите, чтобы они упорядочивались столбцом cyl.

Ответ 5

Это решение использует только dplyr и tidyr, позволяет указывать свои квантили в цепочке dplyr и использует tidyr::crossing() для "укладки" нескольких копий набора данных перед группировкой и суммированием.

diamonds %>%  # Initial data
  tidyr::crossing(pctile = 0:4/4) %>%  # Specify quantiles; crossing() is like expand.grid()
  dplyr::group_by(cut, pctile) %>%  # Indicate your grouping var, plus your quantile var
  dplyr::summarise(quantile_value = quantile(price, unique(pctile))) %>%  # unique() is needed
  dplyr::mutate(pctile = sprintf("%1.0f%%", pctile*100))  # Optional prettification

Результат:

# A tibble: 25 x 3
# Groups:   cut [5]
         cut pctile quantile_value
       <ord>  <chr>          <dbl>
 1      Fair     0%         337.00
 2      Fair    25%        2050.25
 3      Fair    50%        3282.00
 4      Fair    75%        5205.50
 5      Fair   100%       18574.00
 6      Good     0%         327.00
 7      Good    25%        1145.00
 8      Good    50%        3050.50
 9      Good    75%        5028.00
10      Good   100%       18788.00
11 Very Good     0%         336.00
12 Very Good    25%         912.00
13 Very Good    50%        2648.00
14 Very Good    75%        5372.75
15 Very Good   100%       18818.00
16   Premium     0%         326.00
17   Premium    25%        1046.00
18   Premium    50%        3185.00
19   Premium    75%        6296.00
20   Premium   100%       18823.00
21     Ideal     0%         326.00
22     Ideal    25%         878.00
23     Ideal    50%        1810.00
24     Ideal    75%        4678.50
25     Ideal   100%       18806.00

Функция unique() необходима, чтобы dplyr::summarise() знала, что вам нужно только одно значение на группу.

Ответ 6

Вот решение с использованием комбинации dplyr, purrr и rlang:

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(purrr)

# load data
data("mtcars")

# Percentiles used in calculation
p <- c(.25,.5,.75)

p_names <- paste0(p*100, "%")
p_funs <- map(p, ~partial(quantile, probs = .x, na.rm = TRUE)) %>% 
  set_names(nm = p_names)

# dplyr/purrr/rlang solution 
mtcars %>% 
  group_by(cyl) %>% 
  summarize_at(vars(mpg), funs(!!!p_funs))
#> # A tibble: 3 x 4
#>     cyl '25%' '50%' '75%'
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     4  22.8  26    30.4
#> 2     6  18.6  19.7  21  
#> 3     8  14.4  15.2  16.2


#Especially useful if you want to summarize more variables
mtcars %>% 
  group_by(cyl) %>% 
  summarize_at(vars(mpg, drat), funs(!!!p_funs))
#> # A tibble: 3 x 7
#>     cyl 'mpg_25%' 'drat_25%' 'mpg_50%' 'drat_50%' 'mpg_75%' 'drat_75%'
#>   <dbl>     <dbl>      <dbl>     <dbl>      <dbl>     <dbl>      <dbl>
#> 1     4      22.8       3.81      26         4.08      30.4       4.16
#> 2     6      18.6       3.35      19.7       3.9       21         3.91
#> 3     8      14.4       3.07      15.2       3.12      16.2       3.22

Создано в 2018-10-01 пакетом представлением (v0.2.0).

Изменить (2019-04-17):

По dplyr 0.8.0, то funs функция устарели в пользу использования list, чтобы передать требуемые функции в контекстную dplyr функции. В результате вышеописанная реализация становится немного более простой. Нам больше не нужно беспокоиться об отключении функций с помощью !!! , Пожалуйста, смотрите ниже reprex:

library(dplyr)
#> Warning: package 'dplyr' was built under R version 3.5.2
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(purrr)

# load data
data("mtcars")

# Percentiles used in calculation
p <- c(.25,.5,.75)

p_names <- paste0(p*100, "%")
p_funs <- map(p, ~partial(quantile, probs = .x, na.rm = TRUE)) %>% 
  set_names(nm = p_names)

# dplyr/purrr/rlang solution 
mtcars %>% 
  group_by(cyl) %>% 
  summarize_at(vars(mpg), p_funs)
#> # A tibble: 3 x 4
#>     cyl '25%' '50%' '75%'
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     4  22.8  26    30.4
#> 2     6  18.6  19.7  21  
#> 3     8  14.4  15.2  16.2


#Especially useful if you want to summarize more variables
mtcars %>% 
  group_by(cyl) %>% 
  summarize_at(vars(mpg, drat), p_funs)
#> # A tibble: 3 x 7
#>     cyl 'mpg_25%' 'drat_25%' 'mpg_50%' 'drat_50%' 'mpg_75%' 'drat_75%'
#>   <dbl>     <dbl>      <dbl>     <dbl>      <dbl>     <dbl>      <dbl>
#> 1     4      22.8       3.81      26         4.08      30.4       4.16
#> 2     6      18.6       3.35      19.7       3.9       21         3.91
#> 3     8      14.4       3.07      15.2       3.12      16.2       3.22

Создано в 2019-04-17 пакетом представлением (v0.2.0).

Ответ 7

Здесь довольно читаемое решение, которое использует dplyr и purrr для возврата квантилей в аккуратном формате:

код

library(dplyr)
library(purrr)

mtcars %>% 
    group_by(cyl) %>% 
    do({x <- .$mpg
        map_dfr(.x = c(.25, .5, .75),
                .f = ~ data_frame(Quantile = .x,
                                  Value = quantile(x, probs = .x)))
       })

Результат

# A tibble: 9 x 3
# Groups:   cyl [3]
    cyl Quantile Value
  <dbl>    <dbl> <dbl>
1     4     0.25 22.80
2     4     0.50 26.00
3     4     0.75 30.40
4     6     0.25 18.65
5     6     0.50 19.70
6     6     0.75 21.00
7     8     0.25 14.40
8     8     0.50 15.20
9     8     0.75 16.25

Ответ 8

do() на самом деле является правильной идиомой, так как она предназначена для групповых преобразований. Думайте об этом как о lapply() который отображает группы фрейма данных. (Для такой специализированной функции родовое имя типа "до" не идеально. Но, вероятно, уже слишком поздно его менять.)

Морально внутри каждой группы cyl вы хотите применить quantile() к столбцу mpg:

library(dplyr)

p <- c(.2, .5, .75)

mtcars %>% 
  group_by(cyl) %>%
  do(quantile(.$mpg, p))

#> Error: Results 1, 2, 3 must be data frames, not numeric

За исключением того, что это не работает, потому что quantile() не возвращает фрейм данных; Вы должны преобразовать его вывод явно. Поскольку это изменение означает оборачивание quantile() фреймом данных, вы можете использовать оператор композиции гештальт- функции %>>>%:

library(gestalt)
library(tibble)

quantile_tbl <- quantile %>>>% enframe("quantile")

mtcars %>% 
  group_by(cyl) %>%
  do(quantile_tbl(.$mpg, p))

#> # A tibble: 9 x 3
#> # Groups:   cyl [3]
#>     cyl quantile value
#>   <dbl> <chr>    <dbl>
#> 1     4 20%       22.8
#> 2     4 50%       26  
#> 3     4 75%       30.4
#> 4     6 20%       18.3
#> 5     6 50%       19.7
#> 6     6 75%       21  
#> 7     8 20%       13.9
#> 8     8 50%       15.2
#> 9     8 75%       16.2

Ответ 9

Ответили много разных способов. dplyr отчетливо изменил то, что я хотел сделать..

mtcars %>%
   select(cyl, mpg) %>%
   group_by(cyl) %>%
   mutate( qnt_0   = quantile(mpg, probs= 0),
           qnt_25  = quantile(mpg, probs= 0.25),
           qnt_50  = quantile(mpg, probs= 0.5),
           qnt_75  = quantile(mpg, probs= 0.75),
           qnt_100 = quantile(mpg, probs= 1),
              mean = mean(mpg),
                sd = sd(mpg)
          ) %>%
   distinct(qnt_0 ,qnt_25 ,qnt_50 ,qnt_75 ,qnt_100 ,mean ,sd)

оказывает

# A tibble: 3 x 8
# Groups:   cyl [3]
  qnt_0 qnt_25 qnt_50 qnt_75 qnt_100  mean    sd   cyl
  <dbl>  <dbl>  <dbl>  <dbl>   <dbl> <dbl> <dbl> <dbl>
1  17.8   18.6   19.7   21      21.4  19.7  1.45     6
2  21.4   22.8   26     30.4    33.9  26.7  4.51     4
3  10.4   14.4   15.2   16.2    19.2  15.1  2.56     8