在 R 中将组副标题和小计行添加到 data.frame 或 table
Add Group Subheader and Subtotal Rows to data.frame or table in R
Objective
我希望在 table 中添加子标题和 subtotal/margin 行。最终，我正在寻找如下所示的结构，我将使用 openxlsx 和 writeData.
将其导出到 Excel
2019
2020
2021
A
A1
1001
1157
911
A2
1005
803
1110
A3
1125
897
1190
Total A
3131
2857
3211
B
B1
806
982
1098
B2
1106
945
1080
B3
1057
1123
867
Total B
2969
3050
3045
C
C1
847
1087
1140
C2
1146
966
1176
C3
1071
915
892
Total C
3064
2968
3208
Total All
9164
8875
9464
我怀疑小标题和小计是完全不同的问题，但我在这里问这两个问题，以防每个问题都有一个通用的方法。
到目前为止可重现的代码
创建示例数据（长格式）：
d <- data.frame(
year = rep(c(2019, 2020, 2021), times = 9),
sector = rep(c("A","B","C"),each = 9),
subsector = paste0(rep(c("A","B","C"),each = 9), rep(c("1","2","3"), each = 3)),
value = sample(800:1200, 27, replace = FALSE)
)
输出：
head(d)
#> year sector subsector value
#> 1 2019 A A1 1001
#> 2 2020 A A1 1157
#> 3 2021 A A1 911
#> 4 2019 A A2 1005
#> 5 2020 A A2 803
#> 6 2021 A A2 1110
设置宽格式并添加边距（总）行：
library(janitor)
#[snip]warnings[/snip]
library(tidyverse)
#[snip]warnings[/snip]
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE)) %>%
pivot_wider(names_from = year, values_from = sales) %>%
janitor::adorn_totals(where = "row")
输出：
#> `summarise()` has grouped output by 'year', 'sector'. You can override using the `.groups` argument.
#> sector subsector 2019 2020 2021
#> A A1 1001 1157 911
#> A A2 1005 803 1110
#> A A3 1125 897 1190
#> B B1 806 982 1098
#> B B2 1106 945 1080
#> B B3 1057 1123 867
#> C C1 847 1087 1140
#> C C2 1146 966 1176
#> C C3 1071 915 892
#> Total - 9164 8875 9464
由 reprex package (v2.0.1)
于 2022 年 3 月 2 日创建
janitor 包的 adorn_totals() 函数非常适合为整个集合添加边距行或列。 Sam Firke 的回复 暗示了使用 tidyr::gather 的解决方案，但我的数据格式不同。我不想“收集”这些列。同一线程中的其他人显示了解决方案，但他们将所有总数放在 table.
的末尾
我可以想象一个解决方案，我循环遍历扇区因子和 assemble 并为每个扇区组合 tables，但我怀疑我想多了，还有一个更简单的解决方案。
是否有针对此 objective 的现有解决方案，或实现此 efficiently/universally 的想法？
请注意：每个部门的子部门数量在实际数据中会有所不同（即有些可能只有一个子部门，有些可能有多个），并且没有与子部门相关的命名规则到扇区（即 parent 扇区将不会成为 child 子扇区名称的一部分：而不是扇区：“A”，子扇区：“A1"，它可能是行业："制造业"，子行业："汽车")。
@akrun -- 解决方案！
你的回答让我完成了 90% 的事情，你随后的评论让我找到了剩下的解决方案。
gt 有一个函数 as_raw_html()，它使用 xml2::read_html() 和 rvest::html_table() 将 gt() object 转换为 tibble，同时保持副标题。
library(dplyr)
library(tidyr)
library(purrr)
library(gt)
library(xml2)
library(rvest)
d <- data.frame(
year = rep(c(2019, 2020, 2021), times = 9),
sector = rep(c("A","B","C"),each = 9),
subsector = paste0(rep(c("A","B","C"),each = 9), rep(c("1","2","3"), each = 3)),
value = sample(800:1200, 27, replace = FALSE)
)
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
gt() %>%
gt::as_raw_html() %>%
xml2::read_html() %>%
rvest::html_table()
#> [[1]]
#> # A tibble: 15 x 4
#> subsector `2019` `2020` `2021`
#> <chr> <chr> <chr> <chr>
#> 1 A A A A
#> 2 A1 932 1117 800
#> 3 A2 925 1078 1090
#> 4 A3 816 1058 1146
#> 5 Total 2673 3253 3036
#> 6 B B B B
#> 7 B1 862 1181 947
#> 8 B2 1083 812 912
#> 9 B3 1079 1130 1097
#> 10 Total 3024 3123 2956
#> 11 C C C C
#> 12 C1 966 895 944
#> 13 C2 970 1147 1166
#> 14 C3 1043 1116 826
#> 15 Total 2979 3158 2936
由 reprex package (v2.0.1)
于 2022 年 3 月 2 日创建
子标题行在所有列中重复扇区名称；除此之外，它看起来不错。
有趣的是，rvest 也有一个 read_html 函数，它甚至可能引用 xml2::read_html() 函数，但它在这种情况下不起作用。
不是对整个摘要应用 adorn_totals，而是使用 group_modify，然后转换为 gt
library(dplyr)
library(tidyr)
library(purrr)
library(janitor)
library(gt)
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
gt()
-输出
一个选项也是用 expss
拆分列
library(expss)
library(openxlsx)
out <- d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
ungroup %>%
split_columns(columns = 1)
wb <- createWorkbook()
sh <- addWorksheet(wb, "Tables")
xl_write(out, wb, sh)
saveWorkbook(wb, file.path(getwd(), "Documents/table1.xlsx"), overwrite = TRUE)
-输出
Objective
我希望在 table 中添加子标题和 subtotal/margin 行。最终，我正在寻找如下所示的结构，我将使用 openxlsx 和 writeData.
| 2019 | 2020 | 2021 | |
|---|---|---|---|
| A | |||
| A1 | 1001 | 1157 | 911 |
| A2 | 1005 | 803 | 1110 |
| A3 | 1125 | 897 | 1190 |
| Total A | 3131 | 2857 | 3211 |
| B | |||
| B1 | 806 | 982 | 1098 |
| B2 | 1106 | 945 | 1080 |
| B3 | 1057 | 1123 | 867 |
| Total B | 2969 | 3050 | 3045 |
| C | |||
| C1 | 847 | 1087 | 1140 |
| C2 | 1146 | 966 | 1176 |
| C3 | 1071 | 915 | 892 |
| Total C | 3064 | 2968 | 3208 |
| Total All | 9164 | 8875 | 9464 |
我怀疑小标题和小计是完全不同的问题，但我在这里问这两个问题，以防每个问题都有一个通用的方法。
到目前为止可重现的代码
创建示例数据（长格式）：
d <- data.frame(
year = rep(c(2019, 2020, 2021), times = 9),
sector = rep(c("A","B","C"),each = 9),
subsector = paste0(rep(c("A","B","C"),each = 9), rep(c("1","2","3"), each = 3)),
value = sample(800:1200, 27, replace = FALSE)
)
输出：
head(d)
#> year sector subsector value
#> 1 2019 A A1 1001
#> 2 2020 A A1 1157
#> 3 2021 A A1 911
#> 4 2019 A A2 1005
#> 5 2020 A A2 803
#> 6 2021 A A2 1110
设置宽格式并添加边距（总）行：
library(janitor)
#[snip]warnings[/snip]
library(tidyverse)
#[snip]warnings[/snip]
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE)) %>%
pivot_wider(names_from = year, values_from = sales) %>%
janitor::adorn_totals(where = "row")
输出：
#> `summarise()` has grouped output by 'year', 'sector'. You can override using the `.groups` argument.
#> sector subsector 2019 2020 2021
#> A A1 1001 1157 911
#> A A2 1005 803 1110
#> A A3 1125 897 1190
#> B B1 806 982 1098
#> B B2 1106 945 1080
#> B B3 1057 1123 867
#> C C1 847 1087 1140
#> C C2 1146 966 1176
#> C C3 1071 915 892
#> Total - 9164 8875 9464
由 reprex package (v2.0.1)
于 2022 年 3 月 2 日创建janitor 包的 adorn_totals() 函数非常适合为整个集合添加边距行或列。 Sam Firke 的回复 tidyr::gather 的解决方案，但我的数据格式不同。我不想“收集”这些列。同一线程中的其他人显示了解决方案，但他们将所有总数放在 table.
我可以想象一个解决方案，我循环遍历扇区因子和 assemble 并为每个扇区组合 tables，但我怀疑我想多了，还有一个更简单的解决方案。
是否有针对此 objective 的现有解决方案，或实现此 efficiently/universally 的想法？
请注意：每个部门的子部门数量在实际数据中会有所不同（即有些可能只有一个子部门，有些可能有多个），并且没有与子部门相关的命名规则到扇区（即 parent 扇区将不会成为 child 子扇区名称的一部分：而不是扇区：“A”，子扇区：“A1"，它可能是行业："制造业"，子行业："汽车")。
@akrun -- 解决方案！
你的回答让我完成了 90% 的事情，你随后的评论让我找到了剩下的解决方案。
gt 有一个函数 as_raw_html()，它使用 xml2::read_html() 和 rvest::html_table() 将 gt() object 转换为 tibble，同时保持副标题。
library(dplyr)
library(tidyr)
library(purrr)
library(gt)
library(xml2)
library(rvest)
d <- data.frame(
year = rep(c(2019, 2020, 2021), times = 9),
sector = rep(c("A","B","C"),each = 9),
subsector = paste0(rep(c("A","B","C"),each = 9), rep(c("1","2","3"), each = 3)),
value = sample(800:1200, 27, replace = FALSE)
)
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
gt() %>%
gt::as_raw_html() %>%
xml2::read_html() %>%
rvest::html_table()
#> [[1]]
#> # A tibble: 15 x 4
#> subsector `2019` `2020` `2021`
#> <chr> <chr> <chr> <chr>
#> 1 A A A A
#> 2 A1 932 1117 800
#> 3 A2 925 1078 1090
#> 4 A3 816 1058 1146
#> 5 Total 2673 3253 3036
#> 6 B B B B
#> 7 B1 862 1181 947
#> 8 B2 1083 812 912
#> 9 B3 1079 1130 1097
#> 10 Total 3024 3123 2956
#> 11 C C C C
#> 12 C1 966 895 944
#> 13 C2 970 1147 1166
#> 14 C3 1043 1116 826
#> 15 Total 2979 3158 2936
由 reprex package (v2.0.1)
于 2022 年 3 月 2 日创建子标题行在所有列中重复扇区名称；除此之外，它看起来不错。
有趣的是，rvest 也有一个 read_html 函数，它甚至可能引用 xml2::read_html() 函数，但它在这种情况下不起作用。
不是对整个摘要应用 adorn_totals，而是使用 group_modify，然后转换为 gt
library(dplyr)
library(tidyr)
library(purrr)
library(janitor)
library(gt)
d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
gt()
-输出
一个选项也是用 expss
library(expss)
library(openxlsx)
out <- d %>%
group_by(year, sector, subsector) %>%
summarise(sales = sum(value, na.rm = TRUE), .groups = 'drop') %>%
pivot_wider(names_from = year, values_from = sales) %>%
group_by(sector) %>%
group_modify(~ .x %>% adorn_totals(where = "row")) %>%
ungroup %>%
split_columns(columns = 1)
wb <- createWorkbook()
sh <- addWorksheet(wb, "Tables")
xl_write(out, wb, sh)
saveWorkbook(wb, file.path(getwd(), "Documents/table1.xlsx"), overwrite = TRUE)
-输出