如何在R语言中为HTML标签创建颜色渐变（gt包实现）

需求说明 #

需要为数据列RFD.Diff设置两种背景渐变效果：

• 数值在 0~100.8 区间时，应用红→白的横向渐变背景
• 数值在 -100.8~0 区间时，应用白→绿的横向渐变背景

原始数据结构 #

structure(list(RFD.Diff = c(8.4, 56.6, -36.3, 26, -15.9, -8.1, 35.3, 66.8, 100.8, -20.2, 63.6, -9.7, -24.8, -4.6, 11.6, 21.3, 9.1, -0.9)), class = "data.frame", row.names = c(NA, -18L))

原始实现代码 #

渐变生成函数 #

add_cyl_color2 <- function(RFD.Diff){
  # 定义颜色值
  red_val <- "#FF0000"
  white_val <- "#FFFFFF"
  green_val <- "#00FF00"
  # 根据数值计算渐变参数
  if (RFD.Diff >= 0) {
    color_val <- paste0(
      "background: linear-gradient(to right, ", 
      red_val, " ", round((100.8 - RFD.Diff) / 100.8 * 100), "%, ", 
      white_val, " ", round(RFD.Diff / 100.8 * 100), "); color: #000000;"
    )
  } else {
    color_val <- paste0(
      "background: linear-gradient(to right, ", 
      white_val, " ", round((100.8 + RFD.Diff) / 100.8 * 100), "%, ", 
      green_val, " ", round(-RFD.Diff / 100.8 * 100), "); color: #000000;"
    )
  }
  # 创建带样式的HTML元素
  div_out <- htmltools::div(
    style = paste(
      "display: inline-block; padding: 10px 30px; border-radius: 8px; font-weight: 1000; font-size: 15px;",
      color_val
    ),
    paste(RFD.Diff)
  )
  as.character(div_out) %>% gt::html()
}

gt表格渲染代码 #

data %>% 
  mutate(RFD.Diff = purrr::map(RFD.Diff, add_cyl_color2)) %>% 
  gt() %>%
  cols_label(
    RFD.Diff = md("Braking RFD"),
  ) %>%
  tab_style(
    cell_text(align = "center"),
    locations = cells_body(
      columns = everything(),
      rows = everything()
    )
  ) %>%
  tab_style(
    cell_borders(
      sides = c("all"),
      style = "hidden"
    ),
    locations = cells_body(
      columns = everything(),
      rows = everything()
    )
  ) %>%
  opt_align_table_header(align = "left") %>%
  cols_width(
    RFD.Diff ~ px(100)
  )

优化与问题修复 #

问题点分析 #

原始代码存在两个潜在问题：

1. 渐变百分比计算可能出现重叠或空白：比如当RFD.Diff=100.8时，红色占比为0%，白色占比为100%，渐变会直接显示纯白色；同理RFD.Diff=-100.8时会直接显示纯绿色，渐变效果失效。
2. 使用purrr::map处理单个值效率偏低，可通过向量化优化。

优化后的代码 #

向量化渐变函数

add_cyl_color2 <- Vectorize(function(RFD.Diff){
  red_val <- "#FF0000"
  white_val <- "#FFFFFF"
  green_val <- "#00FF00"
  
  if (RFD.Diff >= 0) {
    # 调整百分比计算，确保渐变自然衔接
    red_pct <- round((100.8 - RFD.Diff)/100.8 * 100)
    white_pct <- red_pct + 1  # 避免空白区域，让白色从红色结束的下一个百分比开始
    color_val <- paste0(
      "background: linear-gradient(to right, ", 
      red_val, " ", red_pct, "%, ", 
      white_val, " ", white_pct, "%); color: #000000;"
    )
  } else {
    white_pct <- round((100.8 + RFD.Diff)/100.8 * 100)
    green_pct <- white_pct + 1
    color_val <- paste0(
      "background: linear-gradient(to right, ", 
      white_val, " ", white_pct, "%, ", 
      green_val, " ", green_pct, "%); color: #000000;"
    )
  }
  
  div_out <- htmltools::div(
    style = paste(
      "display: inline-block; width: 100%; padding: 10px 0; border-radius: 8px; font-weight: 900; font-size: 15px; text-align: center;",
      color_val
    ),
    paste(RFD.Diff)
  )
  as.character(div_out) %>% gt::html()
})

简化后的gt表格代码

data %>% 
  mutate(RFD.Diff = add_cyl_color2(RFD.Diff)) %>%  # 直接调用向量化函数，无需map
  gt() %>%
  cols_label(RFD.Diff = md("Braking RFD")) %>%
  tab_style(
    cell_text(align = "center"),
    locations = cells_body(everything())
  ) %>%
  tab_style(
    cell_borders(sides = "all", style = "hidden"),
    locations = cells_body(everything())
  ) %>%
  opt_align_table_header(align = "left") %>%
  cols_width(RFD.Diff ~ px(150))  # 加宽列宽让渐变效果更清晰

优化效果说明 #

• 向量化函数处理更高效，无需依赖purrr包
• 调整渐变百分比逻辑，避免渐变断层或失效
• 固定div宽度为100%，让渐变背景充满整个单元格，视觉效果更统一

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