使用dplyr窗口函数计算百分位数

Question

使用dplyr窗口函数计算百分位数

65

我有一个可行的解决方案，但正在寻找一种更加清晰、易读，可能利用一些较新的dplyr窗口函数的解决方案。

使用mtcars数据集，如果我想查看每个气缸数("cyl")对应的平均数和数量以及每加仑英里数("mpg")的第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”语句。

谢谢

- dreww2

我应该补充说明这段代码还使用了“tidyr”包，其中“spread”函数也是从那里来的。 - dreww2

11个回答

45

如果你想使用 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

^{使用reprex包（v0.2.1）于2018-11-10创建}

这种方法的一个好处是输出结果整洁，每行一个观察值。

- Julia Silge

谢谢，我认为这是最清晰的方法。 - Fato39

我唯一要添加的是在末尾加上一个“spread”，以使事物成为表格形式，以便于展示，即%>% spread(names,x)。 - Abhijit

现在尝试这个，我遇到了'tidy.numeric' is deprecated.的停止提示。 - dbo

谢谢@doconnor。我已经更新了我的答案，不再使用broom。 - Julia Silge

2

一直困扰我的是无法利用内置的tidyverse功能在一行中完成mutate部分，但我刚意识到enframe函数可以将其转换为一行代码：mutate(Quantiles = map(data, ~ enframe(quantile(.$mpg), "quantile")))。 - eipi10

18

这是一个使用dplyr方法的例子，它使用了broom包的tidy()函数，但不幸的是仍然需要使用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程序包没有命名数字的方法。

这是基于我此处summary()的早期答案。

- Bastiaan Quast

1

如果您还想更改列名，甚至可以使用 tidy::spread() 而不是 t() 和 stringr::str_c()：

mtcars %>% group_by(cyl) %>% do(tidy(quantile(.$mpg))) %>% mutate(names = stringr::str_c("Q", names)) %>% tidyr::spread(names, x)

。这种方法更冗长，但可以让您进行一些自由调整。 - giovannotti

tidy已被弃用，建议使用tibble :: as_tibble()。 - jsta

12

不确定如何避免在dplyr中使用do()，但你可以通过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

如果您想按cyl列排序，请使用keyby代替by。

- Arun

好的。我知道在[.data.table中有as.list方法，我尝试在dplyr中使用它，但失败了。 - IRTFM

这是一个不错的解决方案 - 我希望我能在我的特定项目中使用它，但由于与答案本身无关的原因，我不能使用它。 - dreww2

8

有很多种不同的回答。dplyr的distinct函数是我想要做的事情的关键所在。

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

- Antex

жңүжІЎжңүзҗҶз”ұе…ҲдҪҝз”Ёmutate()з„¶еҗҺеҶҚдҪҝз”Ёdistinct()иҖҢдёҚжҳҜдҪҝз”Ёsummarize()пјҹ - savagedata

"distinct()" 的原因是为了只保留每个 "cyl" 下的一行数据。切割橙子总有多种方法，我今天可能会使用 summarize。 - Antex

6

这个解决方案仅使用 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() 知道你只想要每个组的一个值。

- isDotR

4

以下是使用 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月1日，使用了reprex包（v0.2.0）。

编辑（2019年4月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

这段内容是由 reprex package (v0.2.0)在2019年4月17日创建的。

- tbradley

这很有帮助。不知道为什么这个还没有任何赞。 - tjebo

将这三行代码封装成一个函数会使它看起来更整洁，使用 p_funs<-function() {etc}。在这种情况下，在 funs 调用中需要使用 !!!p_funs()。 - tjebo

随着dplyr的新版本，funs函数已经被软弃用，现在你只需要在summarize_at中调用p_funs即可。请参见我上面的编辑。 - tbradley

1

以下是使用 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)))
       })

Result

# 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

- bschneidr

1

使用unnest_wider/longer，可以实现另一种方式来完成这个任务。

    mtcars %>%
       group_by(cyl) %>%
       summarise(quants = list(quantile(mpg, probs = c(.01, .1, .25, .5, .75, .90,.99)))) %>%
       unnest_wider(quants)

如果您想对多个变量执行此操作，可以在分组之前进行收集：

mtcars %>%
   gather(key = 'metric', value = 'value', -cyl) %>%
   group_by(cyl, metric) %>%
   summarise(quants = list(quantile(value, probs = c(.01, .1, .25, .5, .75, .90,.99)))) %>%
  unnest_wider(quants)

- kkent

0

你可以使用我的timeplyr包中的q_summarise()函数。

它既基于tidy（使用数据掩码规则），又非常快速，因为它在内部使用了collapse和data.table。

# To install, uncomment the below line
# remotes::install_github("NicChr/timeplyr")

library(tidyverse)
library(timeplyr)

mtcars %>%
  q_summarise(mpg, .by = cyl, probs = p)
#>    cyl   p25  p50   p75
#> 1:   4 22.80 26.0 30.40
#> 2:   6 18.65 19.7 21.00
#> 3:   8 14.40 15.2 16.25

mtcars %>%
  q_summarise(mpg, .by = cyl, probs = p, pivot = "long")
#>    cyl .quantile   mpg
#> 1:   4       p25 22.80
#> 2:   4       p50 26.00
#> 3:   4       p75 30.40
#> 4:   6       p25 18.65
#> 5:   6       p50 19.70
#> 6:   6       p75 21.00
#> 7:   8       p25 14.40
#> 8:   8       p50 15.20
#> 9:   8       p75 16.25

# Comparison when there are lots of groups

df <- tibble(g = sample.int(10^4, replace = TRUE),
                             x = rnorm(10^4))

bench::mark(timeplyr = q_summarise(df, x, .by = g,
                        pivot = "long", probs = seq(0, 1, 0.25)),
            dplyr = q_by_group(df, x, g, probs = seq(0, 1, 0.25)),
            check = FALSE)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 timeplyr     27.7ms   31.4ms    29.7      2.06MB     5.95
#> 2 dplyr          1.5s     1.5s     0.665    5.33MB     5.99

^{创建于2023-07-10，使用reprex v2.0.2}

- NicChr

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- eipi10 · Accepted Answer

在 dplyr 1.0 中，summarise 可以返回多个值，从而允许以下操作：

library(tidyverse)

mtcars %>% 
  group_by(cyl) %>%  
  summarise(quantile = scales::percent(c(0.25, 0.5, 0.75)),
            mpg = quantile(mpg, c(0.25, 0.5, 0.75)))

或者，您可以使用enframe来避免单独命名分位数的行：

mtcars %>% 
  group_by(cyl) %>%  
  summarise(enframe(quantile(mpg, c(0.25, 0.5, 0.75)), "quantile", "mpg"))

    cyl quantile   mpg
  <dbl> <chr>    <dbl>
1     4 25%       22.8
2     4 50%       26  
3     4 75%       30.4
4     6 25%       18.6
5     6 50%       19.7
6     6 75%       21  
7     8 25%       14.4
8     8 50%       15.2
9     8 75%       16.2

注意：从 dplyr 1.1.0 开始，使用 summarise 返回每个组多行已被弃用。请改用 reframe，例如：

mtcars %>% 
 group_by(cyl) %>%  
 reframe(enframe(quantile(mpg, c(0.25, 0.5, 0.75)), "quantile", "mpg"))

以前版本的 dplyr 的解答

library(tidyverse)

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

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

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

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)