在Rmarkdown演示中按分组和列实现DT包styleColorBar彩色条

需要在RMarkdown演示文稿的DT数据表中，按**行分组（Group列的A/B/C/D/E组）和列分组（area/city/region类列）**分别应用styleColorBar格式，且因实际列数较多，需要程序化的实现方案。当前代码只能对整列应用颜色条，无法按行分组生成对应范围的彩色条，且代码重复冗余。

核心思路 #

• 定义列组与颜色的映射关系，便于批量处理
• 使用DT::styleColorBar结合自定义JS函数，实现按Group分组计算列值范围，生成对应组内的颜色条
• 利用循环批量应用格式，避免重复代码
• 保留货币、百分比的格式化需求

完整代码 #

---
title: "Table Format"
output: slidy_presentation
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

library(DT)
library(tidyverse)

# 使用提供的内置数据
df <- structure(list(Group = c("A", "A", "A", "B", "B", "B", "B", "C", 
"C", "C", "C", "C", "C", "D", "D", "D", "E", "E"), area_col1 = c(113L, 
112L, 102L, 380L, 366L, 481L, 269L, 14L, 5L, 13L, 14L, 9L, 8L, 
62L, 43L, 52L, 9L, 9L), area_col2 = c(4411L, 3714L, 5317L, 14085L, 
16567L, 18276L, 12776L, 5801L, 4744L, 6836L, 5913L, 2858L, 3119L, 
843L, 446L, 497L, 380L, 449L), city_col1 = c(0.11, 0.1, 0.06, 
0.03, 1, 0.06, 0.11, 0.05, 0.04, 0.08, 1, 0.01, 0.16, 0.05, 0.04, 
0.34, 0.11, 1), city_col2 = c(0, 0, 0, 0, 0.01, 0, 0, 0.01, 0, 
0, 0.02, 0, 0.02, 0, 0, 0.01, 0, 0.8), region_col2 = c(0.16, 
0.04, 0.05, 0.12, 0.08, 0.03, 0.1, 0, 0, 0, 0, 0.78, 0, 0.12, 
0.02, 0.01, 0.07, 0.01), region_col3 = c(0.06, 0.23, 0.07, 0.15, 
0.11, 0.02, 0.06, 0, 0, 0, 0.01, 0, 0.01, 0.09, 0.14, 0.02, 0.07, 
0.06)), class = "data.frame", row.names = c(NA, -18L))

# 定义列组与对应颜色的映射
col_groups <- list(
  area = list(cols = c("area_col1", "area_col2"), color = "lightblue"),
  city = list(cols = c("city_col1", "city_col2"), color = "orange"),
  region = list(cols = c("region_col2", "region_col3"), color = "lightgreen")
)

# 预处理：计算每个Group内各列的min和max，生成JS可用的范围数据
group_ranges <- df %>%
  group_by(Group) %>%
  summarise(across(all_of(unlist(map(col_groups, "cols"))), list(min = min, max = max))) %>%
  pivot_longer(-Group, names_sep = "_", names_to = c("col", ".value")) %>%
  pivot_wider(names_from = col, values_from = c(min, max)) %>%
  mutate(Group = as.character(Group)) %>%
  deframe() %>%
  split(names(.) %>% str_extract("^min_|^max_") %>% str_remove("_"))

# 自定义JS函数：根据当前行的Group获取对应列的范围
get_group_range_js <- JS(
  "function(row, data, colIdx) {",
  "  var group = data[0];", # Group列是第0列
  "  var colName = table.columns(colIdx).header().innerText;",
  "  var min = ", toJSON(group_ranges$min), "[group][colName];",
  "  var max = ", toJSON(group_ranges$max), "[group][colName];",
  "  return [min, max];",
  "}"
)

Table #

# 初始化datatable
dt <- datatable(df, rownames = FALSE,
                options = list(
                  columnDefs = list(list(className = 'dt-center', targets = 0:ncol(df)-1)),
                  pageLength = 18
                ))

# 批量应用styleColorBar格式
for (group in col_groups) {
  dt <- dt %>%
    formatStyle(
      columns = group$cols,
      background = styleColorBar(
        get_group_range_js,
        group$color,
        angle = -90
      ),
      backgroundSize = '100% 100%',
      backgroundRepeat = 'no-repeat',
      backgroundPosition = 'center'
    )
}

# 应用格式转换
dt <- dt %>%
  formatCurrency('area_col2', digits = 0) %>%
  formatPercentage(c(unlist(map(col_groups, "cols"))[-which(unlist(map(col_groups, "cols")) == "area_col1")]), 0)

# 输出表格
dt

### 关键说明
- **组内颜色条实现**：通过预处理计算每个Group内各列的最值，再用自定义JS函数在渲染时匹配当前行Group的列范围，实现组内数据的颜色映射
- **批量扩展性**：新增列组只需在`col_groups`中添加配置，无需重复编写格式化代码
- **格式兼容**：保留了原需求中的货币、百分比格式化规则

内容的提问来源于stack exchange，提问作者te time