我想添加总体摘要行,同时还使用 dplyr 按组计算摘要。我发现了各种询问如何执行此操作的问题,例如这里、这里和这里,但没有明确的解决方案。一种可能的方法是执行
count
两次并绑定行:
mtcars %>%
count(cyl, gear) %>%
bind_rows(
count(mtcars, gear)
)
which nearly 产生我需要的东西(最左边的列有 NA 而不是“总计”或类似的):
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
我是否缺少一个更简单/内置的解决方案?
使用 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 这是一个真正有效的解决方案。
一个选项是
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
这是对已接受答案的看法,使用 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 包于 2020-04-07 创建(v0.3.0)
@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
如果您想拥有真正通用的解决方案,您可以使用 purrr::map_df、base::c 和 base::sum 的组合
mtcars %>%
purrr::map_df(~c(.x, sum(.x, na.rm=TRUE))) %>%
tail
附注所有列都必须是数字!
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)
稍微修改了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)
这是我的建议。
注意。如果分组变量是数字,它们将不会在步骤 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"))
也许有效:
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)
由于
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
虽然这是一个老问题,但时不时会出现。
data.table
包具有良好且灵活的功能,例如 cube
、或 rollup
或 groupingsets
,可以高效地完成工作。
setDT(mtcars)
mtcars %>%
count(cyl, gear) %>%
data.table::cube(sum(n), by = c("cyl", "gear"))
输出看起来像,
cyl gear V1
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: 4 NA 11
10: 6 NA 7
11: 8 NA 14
12: NA 3 15
13: NA 4 12
14: NA 5 5
15: NA NA 32