r - 将组副标题和小计行添加到 R 中的 data.frame 或表

Question

目标

我想在表格中添加副标题和小计/边距行。最终，我正在寻找如下所示的结构，我将使用 openxlsx 将其导出到 Excel。和 writeData .

<表类="s-表"><头><日> <日>2019 <日>2020 <日>2021 <正文>一个A110011157911A210058031110A311258971190总A313128573211BB18069821098B211069451080B310571123867总B296930503045CC184710871140C211469661176C31071915892总C306429683208全部合计916488759464

我怀疑子标题和小计是完全不同的问题，但我在这里问这两个问题，以防每个问题都有一个通用的方法。

到目前为止的可重现代码

创建示例数据(长格式):

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 创建于 2022-03-02 (v2.0.1)}

janitor包裹的 adorn_totals()函数适用于为整个集合添加边距行或列。 Sam Firke 的回应 here提示使用 tidyr::gather 的解决方案但我的数据格式不同。我不想“收集”这些列。同一线程中的其他人显示了解决方案，但他们将所有总数放在了表格的末尾。

我可以想象一个解决方案，我循环遍历部门因素并为每个部门组装和组合表格，但我怀疑我想得太多了，还有一个更简单的解决方案。

是否有针对此目标的现有解决方案，或关于高效/普遍实现此目标的想法？

请注意:每个部门的子部门数量在实际数据中会有所不同(即有些可能只有一个子部门，有些可能有多个)，并且没有将子部门与部门相关的命名约定(即，父部门不会成为子部门名称的一部分:而不是部门:“A”，子部门:“A1”，它可能是部门:“制造”，子部门:“汽车”)。

@akrun -- 解决方案!

你的回答让我完成了 90% 的事情，你随后的评论让我找到了剩下的解决方案。

gt有一个函数 as_raw_html()其中，使用 xml2::read_html()和 rvest::html_table()转换 gt()在保留子标题的同时反对小标题。

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 创建于 2022-03-02 (v2.0.1)}

子标题行在所有列中重复扇区名称；除此之外，它看起来不错。

有趣的是，rvest还有一个read_html甚至可能引用 xml2::read_html() 的函数功能，但它在这种情况下不起作用。

Answer 1

不是对整个摘要应用 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)

-输出