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

dre*_*ww2 47 r dplyr tidyr

我有一个有效的解决方案,但我正在寻找一个更清晰,更易读的解决方案,可能会利用一些较新的dplyr窗口函数.

使用mtcars数据集,如果我想查看第25,第50,第75百分位数以及每加仑英里数("mpg")和气缸数("cyl"),我使用以下代码:

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
Run Code Online (Sandbox Code Playgroud)

有没有一种方法可以使用dplyr使用一些汇总函数(n_tiles,percent_rank等)更干净地完成这项工作?干净利落,我的意思是没有"做"声明.

谢谢

eip*_*i10 62

更新2:使用以下内容进行更新,将以前的版本summarise()转换为单行版enframe:

library(tidyverse)

mtcars %>% 
  group_by(cyl) %>% 
  summarise(mpg = list(enframe(quantile(mpg, probs=c(0.25,0.5,0.75))))) %>% 
  unnest
Run Code Online (Sandbox Code Playgroud)
    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
Run Code Online (Sandbox Code Playgroud)

这可以使用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)
Run Code Online (Sandbox Code Playgroud)

更新:这是@ 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
Run Code Online (Sandbox Code Playgroud)

原始答案

这是一种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
Run Code Online (Sandbox Code Playgroud)

它会更好,如果summarise可以用一个单一的调用返回多个值quantile,但是这似乎是一个悬而未决的问题dplyr发展.


Jul*_*lge 36

如果您正在使用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
Run Code Online (Sandbox Code Playgroud)

reprex包创建于2018-11-10 (v0.2.1)

这种方法的一个好处是输出整齐,每行一次观察.

  • 一直困扰着我,无法使用内置的“ tidyverse”功能在同一行中完成“ mutate”部分,但是我只是意识到“ enframe”功能将其变成了单线:`mutate(Quantiles = map (data,〜enframe(quantile(。$ mpg),“ quantile”))))。 (2认同)

Bas*_*ast 16

这是一种dplyr使用包的tidy()功能的方法broom,遗憾的是它仍然需要do(),但它更简单.

library(dplyr)
library(broom)

mtcars %>%
    group_by(cyl) %>%
    do( tidy(t(quantile(.$mpg))) )
Run Code Online (Sandbox Code Playgroud)

这使:

    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
Run Code Online (Sandbox Code Playgroud)

注意使用,t()因为broom包没有命名数字的方法.

这是基于我之前对摘要()的回答.


Aru*_*run 11

不知道如何避免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
Run Code Online (Sandbox Code Playgroud)

如果您希望按列排序,请替换by为.keybycyl


Ant*_*tex 8

回答了很多不同的方式。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)
Run Code Online (Sandbox Code Playgroud)

渲染

# 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
Run Code Online (Sandbox Code Playgroud)


isD*_*otR 6

此解决方案使用dplyrtidyr仅允许您在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
Run Code Online (Sandbox Code Playgroud)

结果:

# 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
Run Code Online (Sandbox Code Playgroud)

unique()让需要dplyr::summarise()知道,你只需要每组一个值。