在R中创建含条形图的分层投票数据表格：技术问题求助

需求概述 #

需要创建包含以下内容的表格：

• 展示2018-2022年选举中男性、女性群体的民主党投票率（%）、共和党投票率（%）
• 投票边际（民主党-共和党）需附带条形图，按正负分别用蓝色/红色（支持自定义颜色，如blue2、red3或十六进制码）
• 表格需具备类似ggplot的分层结构，将年份作为分面维度

现有问题 #

使用formattable、DT包时遇到以下问题：

• 无法实现年份作为分面的分层表头结构
• 投票边际条形图无法根据正负值条件着色
• 无法使用Base R默认以外的自定义颜色
• 使用DT时存在部分数值未着色的额外问题

解决方案：使用gt包实现需求 #

gt包对分层表头、条件格式、自定义颜色支持更完善，以下是完整实现代码：

1. 准备数据 #

library(dplyr)
library(gt)

# 模拟数据（替代原dat2）
data <- data.frame(
  gender = c("Women", "Women", "Women", "Men", "Men", "Men"),
  year = c(2018, 2020, 2022, 2018, 2020, 2022),
  demvote = c(58, 55, 52, 49, 47, 43),
  repvote = c(41, 44, 47, 50, 52, 55),
  margins = c(17, 11, 5, -1, -5, -12)
)

# 整理数据为宽格式（适配分层表头）
table_data <- data %>%
  pivot_wider(
    id_cols = gender,
    names_from = year,
    values_from = c(demvote, repvote, margins)
  )

2. 创建带分层表头与条件着色的表格 #

# 自定义颜色
dem_color <- "#1a5fb4" # 蓝色十六进制码，对应blue2
rep_color <- "#cc0000" # 红色十六进制码，对应red3

# 构建gt表格
gt_table <- gt(table_data) %>%
  # 设置分层表头（年份分面）
  tab_spanner(
    label = "2018",
    columns = c(demvote_2018, repvote_2018, margins_2018)
  ) %>%
  tab_spanner(
    label = "2020",
    columns = c(demvote_2020, repvote_2020, margins_2020)
  ) %>%
  tab_spanner(
    label = "2022",
    columns = c(demvote_2022, repvote_2022, margins_2022)
  ) %>%
  # 设置列标签
  cols_label(
    gender = "群体",
    demvote_2018 = "民主党(%)", repvote_2018 = "共和党(%)", margins_2018 = "投票边际",
    demvote_2020 = "民主党(%)", repvote_2020 = "共和党(%)", margins_2020 = "投票边际",
    demvote_2022 = "民主党(%)", repvote_2022 = "共和党(%)", margins_2022 = "投票边际"
  ) %>%
  # 民主党投票率条形图（自定义蓝色）
  data_color(
    columns = starts_with("demvote"),
    colors = scales::col_numeric(
      palette = c("white", dem_color),
      domain = c(40, 60) # 根据实际数据范围调整
    )
  ) %>%
  # 共和党投票率条形图（自定义红色）
  data_color(
    columns = starts_with("repvote"),
    colors = scales::col_numeric(
      palette = c("white", rep_color),
      domain = c(40, 60) # 根据实际数据范围调整
    )
  ) %>%
  # 投票边际条件着色条形图
  text_transform(
    locations = cells_body(columns = starts_with("margins")),
    fn = function(x) {
      nums <- as.numeric(x)
      max_abs <- max(abs(nums))
      bar_length <- abs(nums) / max_abs * 80 # 条形宽度占单元格比例
      
      lapply(nums, function(num) {
        if (num > 0) {
          htmltools::div(
            style = paste0(
              "background-color: ", dem_color, "; ",
              "width: ", bar_length[which(nums == num)], "%; ",
              "text-align: right; padding-right: 5px;"
            ),
            paste0("+", num)
          )
        } else if (num < 0) {
          htmltools::div(
            style = paste0(
              "background-color: ", rep_color, "; ",
              "width: ", bar_length[which(nums == num)], "%; ",
              "text-align: left; padding-left: 5px;"
            ),
            num
          )
        } else {
          htmltools::div("0")
        }
      })
    }
  ) %>%
  # 美化表格样式
  tab_options(
    table.width = "100%",
    spanner.label.font.weight = "bold",
    column_labels.font.weight = "bold"
  )

# 输出表格
gt_table

代码说明 #

• 分层表头：通过tab_spanner将每年的三个指标归为一组，实现年份分面效果
• 自定义颜色：直接使用十六进制码或R命名颜色（如blue2、red3）定义党派专属颜色
• 条件着色：投票边际根据正负值自动切换蓝/红色条形，正数右对齐、负数左对齐，直观展示差距方向
• 条形适配：基于边际值的最大绝对值计算条形长度，确保幅度与视觉效果匹配

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