首页 文章

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

提问于
浏览
36

我有一个有效的解决方案,但我正在寻找一个更清晰,更易读的解决方案,可能会利用一些较新的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

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

谢谢

8 回答

  • 13

    如果您正在使用 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包创建于2018-11-10(v0.2.1)

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

  • 2

    UPDATE 2: 使用 enframe 将以前版本的 summarise() 转换为单行的另一个更新:

    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)
    

    UPDATE: 这里's a variation on @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
    

    ORIGINAL ANSWER

    这是一个避免 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 返回多个值会更好,但这似乎是 dplyrdplyr 开发中 .

  • 45

    这是一个使用 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 包没有命名数字的方法 .

    这是基于我的earlier answer for summary() here .

  • 0

    不确定如何避免 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 列排序,请将 by 替换为 keyby .

  • 21

    此解决方案仅使用 dplyrtidyr ,允许您在 dplyr 链中指定分位数,并在分组和汇总之前利用 tidyr::crossing() 到"stack"数据集的多个副本 .

    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() 知道您只需要每个组一个值 .

  • 9

    这是一个相当可读的解决方案,它使用 dplyrpurrr 以整齐的格式返回分位数:

    Code

    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
    
  • 0

    以下是使用 dplyrpurrrrlang 组合的解决方案:

    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
    

    reprex package(v0.2.0)创建于2018-10-01 .

  • 0

    do() 实际上是正确的习惯用法,因为它是专为分组转换而设计的 . 可以将其视为映射数据帧组的 lapply() . (对于这样一个专门的函数,像“do”这样的通用名称并不理想 . 但改变它可能为时已晚 . )

    在每个 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() ,因此可以使用gestalt函数组合运算符 %>>>%

    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
    

相关问题