【问题标题】:Add margin row totals in dplyr chain在 dplyr 链中添加边距行总计
【发布时间】:2017-01-23 05:43:25
【问题描述】:

我想添加整体摘要行,同时使用 dplyr 按组计算摘要。我发现了各种问题,询问如何做到这一点,例如hereherehere,但没有明确的解决方案。一种可能的方法是执行两次count 并绑定行:

mtcars %>% 
  count(cyl, gear) %>% 
  bind_rows(
    count(mtcars, gear)
  )

几乎产生了我需要的东西(最左边的列有 NAs 而不是“Total”或类似的):

     cyl  gear     n
   <dbl> <dbl> <int>
1      4     3     1
2      4     4     8
3      4     5     2
4      6     3     2
5      6     4     4
6      6     5     1
7      8     3    12
8      8     5     2
9     NA     3    15
10    NA     4    12
11    NA     5     5

我是否缺少更简单/内置的解决方案?

【问题讨论】:

  • 你可以在基础 R 中做 addmargins(table(mtcars$cyl, mtcars$gear))

标签: r dplyr


【解决方案1】:

使用 janitor 包中的 adorn_totals():

library(janitor)
mtcars %>%
  tabyl(cyl, gear) %>%
  adorn_totals("row") 

   cyl  3  4 5
     4  1  8 2
     6  2  4 1
     8 12  0 2
 Total 15 12 5

要从那里转到帖子中的“长”表单,请将tidyr::gather() 添加到管道中:

mtcars %>%
  tabyl(cyl, gear) %>%
  adorn_totals("row") %>%
  tidyr::gather(gear, n, 2:ncol(.), convert = TRUE)

     cyl gear  n
1      4    3  1
2      6    3  2
3      8    3 12
4  Total    3 15
5      4    4  8
6      6    4  4
7      8    4  0
8  Total    4 12
9      4    5  2
10     6    5  1
11     8    5  2
12 Total    5  5

自我推销提醒,我创作了这个包 - 添加这个答案 b/c 这是一个真正有效的解决方案。

【讨论】:

  • 感谢其他方法建议。我最近开始使用看门人,主要用于 clean_names()、excel_numeric_to_date() 和 remove_empty(),所有这些都对我的日常工作非常有帮助。我现在也将添加这些功能...恭喜您获得了出色的软件包!
【解决方案2】:

一个选项是do

mtcars %>%
   count(cyl, gear) %>%
   ungroup() %>% 
   mutate(cyl=as.character(cyl)) %>% 
   do(bind_rows(., data.frame(cyl="Total", count(mtcars, gear)))) 
   #or replace the last 'do' step with 
   #bind_rows(cbind(cyl='Total', count(mtcars, gear))) #from  @JonnyPolonsky's comments

#      cyl  gear     n
#   <chr> <dbl> <int>
#1      4     3     1
#2      4     4     8
#3      4     5     2
#4      6     3     2
#5      6     4     4
#6      6     5     1
#7      8     3    12
#8      8     5     2
#9  Total     3    15
#10 Total     4    12
#11 Total     5     5

【讨论】:

  • 谢谢@akrun,效果很好。我不确定do 调用是否必要-mtcars %&gt;% count(cyl, gear) %&gt;% ungroup() %&gt;% mutate(cyl=as.character(cyl)) %&gt;% bind_rows(cbind(cyl='Total', count(mtcars, gear))) 也可以。我会等着看是否有人提供内置的dplyr 答案,并会在 24 小时内接受。非常感谢
  • @JonnyPolonsky 谢谢,我在公共汽车上,所以无法使用鼠标。应该也可以。
  • 不需要ungroup(). Count() 之前调用group_by() 和之后ungroup()
  • @Nettle 我使用了ungroup,因为有一个mutate 步骤不需要group_by,尽管它适用于group_by
  • @akrun RE:@Jonny 的评论“我不确定 do 调用是否必要”——我刚刚意识到最好使用 do()。在创建行边距时,您希望能够引用.,以便您可以通过前面的步骤以mutate()d 的身份访问数据。通常不可能像在这个简单示例中那样计算原始数据帧的边际统计数据。 do() 提供了这个。
【解决方案3】:

对@arkrun 的答案的补充,不容易添加为评论:

虽然稍微复杂一些,但这种格式允许对数据框进行先前的修改。在生成表之前有较长的动词链时很有用。 (您想更改名称,或仅选择特定变量)

mtcars %>%
   count(cyl, gear) %>%
   ungroup() %>% 
   mutate(cyl=as.character(cyl))
bind_rows(group_by(.,gear) %>%
              summarise(n=sum(n)) %>%
              mutate(cyl='Total')) %>%
spread(cyl)

## A tibble: 3 x 5
#   gear   `4`   `6`   `8` Total
#* <dbl> <dbl> <dbl> <dbl> <dbl>
#1     3     1     2    12    15
#2     4     8     4     0    12
#3     5     2     1     2     5

这也可以加倍以生成展开的总行。

mtcars %>%
  count(cyl, gear) %>%
  ungroup() %>% 
  mutate(cyl=as.character(cyl),
         gear = as.character(gear)) %>%
  bind_rows(group_by(.,gear) %>%
              summarise(n=sum(n)) %>%
              mutate(cyl='Total')) %>%
  bind_rows(group_by(.,cyl) %>%
              summarise(n=sum(n)) %>%
              mutate(gear='Total')) %>%
  spread(cyl,n,fill=0)

# A tibble: 4 x 5
   gear   `4`   `6`   `8` Total
* <chr> <dbl> <dbl> <dbl> <dbl>
1     3     1     2    12    15
2     4     8     4     0    12
3     5     2     1     2     5
4 Total    11     7    14    32

【讨论】:

    【解决方案4】:

    以下是接受的答案,使用 dplyr 1.0.0 和 tidyr 1.0.0 中引入的新功能。

    我们使用新的tidyr::pivot_wider 对计数进行旋转。然后使用新的dplyr::rowwisedplyr::c_across 对总列的计数求和。

    我们也可以使用tidyr::pivot_longer 来获得所需的长格式。

    library(dplyr, warn.conflicts = FALSE)
    library(tidyr)
    
    cyl_gear_sum <- mtcars %>%
      count(cyl, gear) %>%
      pivot_wider(names_from = gear, values_from = n, values_fill = list(n = 0)) %>%
      rowwise(cyl) %>%
      mutate(gear_total = sum(c_across()))
    
    cyl_gear_sum
    #> # A tibble: 3 x 5
    #> # Rowwise:  cyl
    #>     cyl   `3`   `4`   `5` gear_total
    #>   <dbl> <int> <int> <int>      <int>
    #> 1     4     1     8     2         11
    #> 2     6     2     4     1          7
    #> 3     8    12     0     2         14
    
    # total as row
    cyl_gear_sum %>% 
      pivot_longer(-cyl, names_to = "gear", values_to = "n")
    #> # A tibble: 12 x 3
    #>      cyl gear           n
    #>    <dbl> <chr>      <int>
    #>  1     4 3              1
    #>  2     4 4              8
    #>  3     4 5              2
    #>  4     4 gear_total    11
    #>  5     6 3              2
    #>  6     6 4              4
    #>  7     6 5              1
    #>  8     6 gear_total     7
    #>  9     8 3             12
    #> 10     8 4              0
    #> 11     8 5              2
    #> 12     8 gear_total    14
    

    reprex package (v0.3.0) 于 2020-04-07 创建

    【讨论】:

      【解决方案5】:

      如果您想要真正通用的解决方案,您可以使用 purrr::map_df、base::c 和 base::sum 的组合 mtcars %>% purrr::map_df(~c(.x, sum(.x, na.rm=TRUE))) %>% tail

      附:所有列都必须是数字!

      【讨论】:

        【解决方案6】:

        这是我的建议。

        1. 通过 powerSet 函数查找相关分组变量的组合。
        2. 将数据框拆分成一个列表,按分组变量的powerSet进行分组
        3. 使用适当的汇总函数(例如均值)汇总数据框
        4. bind_rows 结果 - 汇总现在为 NA,因为这些列在第 3 步中被删除
        5. 使用适当的名称替换分组变量的 NA 值。

        注意。如果分组变量是数字,它们不会在第 3 步中被删除 - 因此我将它们变为字符变量。

        powerSetList <- function(df, ...) {
          rje::powerSet(x = c(...))[-1] %>% lapply(function(x, tdf = df) group_by(tdf, .dots=x)) %>% c(list(tibble(df)), .)
        } 
        
        mtcars %>% 
          mutate_at(vars("cyl", "gear"), as.character) %>%
          powerSetList("cyl", "gear") %>%
          map(~summarise_if(., is.numeric, .funs = mean)) %>%
          bind_rows() %>%
          replace_na(list(gear = "all gears",
                          cyl = "all cyls"))
        

        【讨论】:

          【解决方案7】:

          也许可行:

          library(dplyr)
          mtcars %>%
              # convert cyl column as.character
              mutate_at("cyl",as.character) %>%
              # add a copy of the origina data with cyl column = 'TOTAL'
              bind_rows(mutate(mtcars, cyl="total")) %>%
              group_by(cyl) %>% summarise_all(sum)
          

          【讨论】:

          • 这是一个优雅的解决方案,但我认为它并没有完全解决原始提问者正在寻找的嵌套分组。
          【解决方案8】:
          library(tidyverse)
          
          #Pre-process mtcars 
          mtcars_pre <-
            as_tibble(mtcars) %>% #remove rownames
            select(cyl, gear) %>% 
            count(cyl, gear) %>% #add row totals
            mutate(
              cyl = as.character(cyl) #Convert to character in order to add "Total"
            )
          
          #> # A tibble: 8 x 3
          #>   cyl    gear     n
          #>   <chr> <dbl> <int>
          #> 1 4         3     1
          #> 2 4         4     8
          #> 3 4         5     2
          #> 4 6         3     2
          #> 5 6         4     4
          #> 6 6         5     1
          #> 7 8         3    12
          #> 8 8         5     2
          
          mtcars_totals <- 
            mtcars_pre %>%
            bind_rows(
              mtcars_pre %>%
                group_by(gear) %>%
                summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
                mutate("cyl" = "Total")
            ) %>% 
            arrange(
              gear
            )
          
          #> # A tibble: 11 x 3
          #>    cyl    gear     n
          #>    <chr> <dbl> <int>
          #>  1 4         3     1
          #>  2 6         3     2
          #>  3 8         3    12
          #>  4 Total     3    15
          #>  5 4         4     8
          #>  6 6         4     4
          #>  7 Total     4    12
          #>  8 4         5     2
          #>  9 6         5     1
          #> 10 8         5     2
          #> 11 Total     5     5
          

          由 reprex 包于 2021-07-13 创建 (v2.0.0)

          【讨论】:

            猜你喜欢
            • 2016-07-02
            • 2022-12-11
            • 2018-12-08
            • 1970-01-01
            • 1970-01-01
            • 1970-01-01
            • 2013-01-22
            • 1970-01-01
            • 1970-01-01
            相关资源
            最近更新 更多