logo标签列表

在dplyr链中添加边距行总计

rdplyr
50
我想使用dplyr添加总结行，同时按组计算摘要。我找到了许多关于如何做到这一点的问题，例如这里、这里和这里，但没有明确的解决方案。一个可能的方法是两次执行count并绑定行：
mtcars %>% 
  count(cyl, gear) %>% 
  bind_rows(
    count(mtcars, gear)
  )

这个几乎满足我的需求（最左边的一列有NA而不是“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

我是否错过了更简单/内置的解决方案？

5
在基础版的 R 中，您可以使用 addmargins(table(mtcars$cyl, mtcars$gear)) 来完成此操作。 - mtoto
10个回答
68
< p >使用来自 janitor 包的 adorn_totals() ：< /p >
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

自我推广提醒，我是这个软件包的作者 - 添加这个回答是因为它是一个真正有效的解决方案。

4
谢谢您提供额外的方法建议。我最近开始使用 janitor，主要是为了 clean_names()、excel_numeric_to_date() 和 remove_empty() 这几个函数，在我日常工作中非常有帮助。现在我会添加这些函数......祝贺你开发出一个非常棒的包！ - Jonny
14

一种选择是使用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
3
谢谢@akrun，这很有效。我不确定do调用是否必要- mtcars %>% count（cyl，gear）％>% ungroup（）％>% mutate（cyl = as.character（cyl））％>% bind_rows（cbind（cyl ='Total'，count（mtcars， gear）））同样有效。如果有人提供了内置的dplyr答案，我会等待24小时，并在没有答案的情况下接受。非常感谢。 - Jonny
1
@JonnyPolonsky 谢谢，我在公交车上，所以不能用鼠标。那应该也可以。 - akrun
不需要使用 ungroup()。在 Count() 调用之前和之后都要使用 group_by()。 - Nettle
@Nettle 我使用了 ungroup，因为有一个 mutate 步骤不需要 group_by，尽管它可以与 group_by 一起使用。 - akrun
1
@akrun 回复 @Jonny 的评论：“我不确定是否需要 do 调用” - 我刚意识到最好使用 do()。在创建行边距时，您希望能够引用 .，以便可以像之前的步骤中 mutate() 一样访问数据。通常情况下，无法像在这个简单的例子中那样从原始数据框计算边际统计信息。do() 提供了这个功能。 - Michael Henry
@MichaelHenry 这是一篇旧帖子。现在有更好的方法来处理这个问题。 - akrun
12

这里提供了一种使用dplyr 1.0.0和tidyr 1.0.0引入的新函数的方法，以对接受的答案进行处理。

我们使用新的tidyr :: pivot_wider函数来转换计数。然后使用新的dplyr :: rowwise和dplyr :: 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包（版本为0.3.0）于2020年4月7日创建的

11
< p >对于@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
1
如果您想要一个真正通用的解决方案，可以使用 purrr::map_df、base::c 和 base::sum 的组合。 mtcars %>% purrr::map_df(~c(.x, sum(.x, na.rm=TRUE))) %>% tail 注：所有列都必须是数字类型！
1

我稍微修改了jlao的代码：

mtcars %>%
  # convert cyl column as.character
  mutate_at("cyl",as.character) %>%
  # add a copy of the original data with cyl column = 'TOTAL'
  bind_rows(mutate(mtcars, cyl="total")) %>%
  count(cyl,gear)
不错和简单，但我建议将已过时的mutate_at替换为mutate（across（cyl，as.character））。 - T. BruceLee
1
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

本文创建于2021年7月13日，使用reprex包（v2.0.0）。

0

由于summarize()可以解包数据框参数，例如across()的输出，因此我们可以使用以下代码构建自己的data.frame。

library(dplyr, w = F)
mtcars %>% 
  group_by(cyl) %>% 
  summarize(
    bind_rows(
      summarize(group_by(across(everything()), gear), n =  n()),
      tibble(gear = NA, n =  n()),
    ),
    .groups = "drop",
  )
#> # A tibble: 11 × 3
#>      cyl  gear     n
#>    <dbl> <dbl> <int>
#>  1     4     3     1
#>  2     4     4     8
#>  3     4     5     2
#>  4     4    NA    11
#>  5     6     3     2
#>  6     6     4     4
#>  7     6     5     1
#>  8     6    NA     7
#>  9     8     3    12
#> 10     8     5     2
#> 11     8    NA    14

本文创建于2022年11月18日，使用reprex v2.0.2。

这里有一个tidyverse风格的函数，可以轻松地完成它：

#' Summarize with margins
#'
#' @inheritParams dplyr::summarize 
#' @param .by list of quosures, usually built with `quos()`
#' @param .all value to use for variables that are not part of the group.
#'   can be a named list using grouping column names.
#'
#' @return
#' @export
#'
#' @examples
#' mtcars %>% 
#'  summarize_with_margins(n =  n(), .by = quos(cyl, c(gear, cyl)))
#' mtcars %>% 
#'  summarize_with_margins(n =  n(), .by = quos(cyl, c(gear, cyl)), .all = Inf)
#' mtcars %>% 
#'  summarize_with_margins(n =  n(), .by = quos(cyl, c(gear, cyl)), .all = list(gear = -1))
summarize_with_margins <- function(.data, ..., .by = NULL, .all = NA) {
  if (!rlang::is_quosures(.by)) {
    rlang::abort('`.by` should be a "quosures" object, use `quos()`.')
  }
  dfs <- purrr::map(.by, function(x) {
    .data %>% 
      group_by(across(!!x)) %>% 
      summarize(..., .groups = "drop")
  })
  all_nms <- unique(unlist(lapply(dfs, names)))
  purrr::map_dfr(dfs, ~{
    .x <- rev(.x)
    new_nms <- setdiff(all_nms, names(.x))
    if(is.list(.all)) {
      new_nms_in_all <- intersect(new_nms, names(.all))
      .x[new_nms] <- NA
      .x[new_nms_in_all] <- .all[new_nms_in_all]
    } else {
      .x[new_nms] <- .all
    }
    .x
  }) %>% rev()
}


library(dplyr, w = F)

mtcars %>% 
  summarize_with_margins(n =  n(), .by = quos(cyl, c(gear, cyl)))
#> # A tibble: 11 × 3
#>     gear   cyl     n
#>    <dbl> <dbl> <int>
#>  1    NA     4    11
#>  2    NA     6     7
#>  3    NA     8    14
#>  4     3     4     1
#>  5     3     6     2
#>  6     3     8    12
#>  7     4     4     8
#>  8     4     6     4
#>  9     5     4     2
#> 10     5     6     1
#> 11     5     8     2
0

或许这样可以：

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)
1
这是一个优雅的解决方案，但我认为它没有完全解决原始提问者寻找的嵌套分组问题。 - Nicholas G Reich
0

这是我的建议。

  1. 通过powerSet函数找到相关分组变量的组合。
  2. 按照分组变量的powerSet将数据框拆分为一个列表。
  3. 使用适当的汇总函数（例如平均值）对数据框进行汇总。
  4. 使用bind_rows函数将结果合并 - 汇总列在步骤3中被删除，因此现在为NA。
  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"))
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接