如何在Shiny仪表板中为数据框数值单元格自定义颜色编码？

可以用gt或DT包配合Shiny实现自定义颜色编码的表格渲染，以下是两种可行方案：

方案一：使用gt包（更直观的样式自定义） #

完整代码 #

library(shiny)
library(gt)

# 定义数值-颜色映射规则
color_map <- c(
  "10" = "red",
  "20" = "green",
  "30" = "blue",
  "40" = "yellow",
  "50" = "purple"
)

# 构建模拟数据框
df <- data.frame(
  Town = c("Town A","Town B", "Town C"),
  Vegetables = c(20, 30, 40),
  Fruits = c(40, 20,30),
  Toiletries = c(30, 20,40),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  titlePanel("超市销售数据颜色编码表"),
  gt_output("colored_table")
)

server <- function(input, output) {
  output$colored_table <- render_gt({
    gt(df) %>%
      # 将Town列设为行标签，模拟相关矩阵结构
      cols_move_to_start(Town) %>%
      tab_options(row_group.as_column = TRUE) %>%
      # 匹配数值设置单元格背景色
      data_color(
        columns = c(Vegetables, Fruits, Toiletries),
        colors = color_map,
        apply_to = "fill"
      ) %>%
      # 调整样式，贴近相关矩阵外观
      tab_options(
        table.border.top.style = "hidden",
        table.border.bottom.style = "hidden",
        column_labels.border.top.style = "solid",
        column_labels.border.bottom.style = "solid",
        row_group.border.top.style = "solid",
        row_group.border.bottom.style = "solid",
        data_row.padding = px(10)
      ) %>%
      # 根据背景色调整文字颜色，保证可读性
      text_transform(
        locations = cells_body(columns = c(Vegetables, Fruits, Toiletries)),
        fn = function(x) {
          text_color <- ifelse(x %in% c("30", "40", "50"), "white", "black")
          paste0("<span style='color:", text_color, "'>", x, "</span>")
        }
      )
  })
}

shinyApp(ui, server)

关键说明 #

• 用color_map严格绑定数值与对应颜色，确保规则精准匹配
• 通过tab_options移除冗余边框、调整内边距，模拟相关矩阵的紧凑布局
• 针对深色背景（蓝、黄、紫）自动切换白色文字，避免数值被遮挡

方案二：使用DT包（更轻量的交互表格） #

完整代码 #

library(shiny)
library(DT)

# 定义数值-颜色映射规则
color_map <- c(
  "10" = "red",
  "20" = "green",
  "30" = "blue",
  "40" = "yellow",
  "50" = "purple"
)

# 构建模拟数据框
df <- data.frame(
  Town = c("Town A","Town B", "Town C"),
  Vegetables = c(20, 30, 40),
  Fruits = c(40, 20,30),
  Toiletries = c(30, 20,40),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  titlePanel("超市销售数据颜色编码表"),
  DTOutput("colored_table")
)

server <- function(input, output) {
  output$colored_table <- renderDT({
    datatable(df, rownames = FALSE) %>%
      # 设置单元格背景色和文字颜色
      formatStyle(
        columns = c("Vegetables", "Fruits", "Toiletries"),
        backgroundColor = styleEqual(names(color_map), color_map),
        color = styleEqual(names(color_map), c("black", "black", "white", "white", "white"))
      ) %>%
      # 调整边框样式，模拟相关矩阵
      formatStyle(
        columns = colnames(df),
        border = "1px solid #ccc"
      ) %>%
      # 隐藏多余控件，只保留表格主体
      setOptions(dom = 't', ordering = FALSE)
  })
}

shinyApp(ui, server)

关键说明 #

• 用styleEqual直接绑定数值与颜色规则，代码更简洁
• 通过setOptions隐藏排序、搜索控件，聚焦表格本身的颜色展示

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