将组子标题和小计行添加到 R 中的 data.frame 或表
AWa*_*ton 3 r dplyr tidyr rvest gt
客观的
我希望在表格中添加副标题和小计/边距行。最终，我正在寻找如下所示的结构，我将使用openxlsx和将其导出到 Excel writeData。
| 2019年 | 2020年 | 2021年 | |
|---|---|---|---|
| A | |||
| A1 | 1001 | 第1157章 | 911 |
| A2 | 1005 | 803 | 1110 |
| A3 | 1125 | 第897章 | 1190 |
| 总A | 3131 | 2857 | 3211 |
| 乙 | |||
| B1 | 806 | 第982章 | 1098 |
| B2 | 1106 | 第945章 | 1080 |
| B3 | 1057 | 1123 | 第867章 |
| 总B | 2969 | 3050 | 3045 |
| C | |||
| C1 | 第847章 | 1087 | 1140 |
| C2 | 1146 | 966 | 第1176章 |
| C3 | 1071 | 915 | 第892章 |
| 总碳 | 3064 | 2968 | 3208 |
| 总计 全部 | 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 包于 2022 年 3 月 2 日创建(v2.0.1)
该janitor包的adorn_totals()功能非常适合为整个集合添加边距行或列。Sam Firke在这里的回应暗示了一个使用tidyr::gather但我的数据采用不同格式的解决方案。我不想“收集”专栏。同一线程中的其他人显示了解决方案，但他们将所有总数放在表格的末尾。
我可以想象一个解决方案，我循环遍历部门因素并为每个部门组装和组合表格，但我怀疑我对此想得太多，并且有一个更简单的解决方案。
是否有针对此目标的现有解决方案，或者有效/普遍实现此目标的想法？
请注意：每个扇区的子扇区数量在实际数据中会有所不同（即，有些可能只有一个子扇区，有些可能有多个），并且子扇区与扇区之间没有命名约定（即父扇区将不是子部门名称的一部分：而不是部门：“ A ”，子部门：“ A 1”，它可能是部门：“制造”，子部门：“汽车”）。
@akrun——解决方案！
你的回答让我完成了 90% 的工作，你随后的评论引导我找到了剩下的解决方案。
gt有一个函数as_raw_html()，使用对象xml2::read_html()并将rvest::html_table()其转换gt()为 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 包于 2022 年 3 月 2 日创建(v2.0.1)
子标题行在所有列中重复扇区名称；除此之外，它看起来不错。
有趣的是，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)
-输出
