R Shiny应用中修改DT数据表列头背景色的实现方法

问题说明 #

在搭载shinytheme("cyborg")主题的Shiny应用中渲染DT表格时，需要将列头背景色（非文字颜色）修改为自定义色值#34a8eb，已尝试两种方案均未生效。

测试数据集 #

df <- structure(list(year = 1980:2021, AvgTMean = c(24.2700686838937, 
23.8852956598276, 25.094446596092, 24.1561175050287, 24.157183605977, 
24.3047482638362, 24.7899738481466, 24.5756232655603, 24.5833086228592, 
24.7344695534483, 25.3094451071121, 25.2100615173707, 24.3651692293534, 
24.5423890611494, 25.2492166633908, 24.7005097837931, 24.2491591827443, 
25.0912281781322, 25.0779264303305, 24.403294248319, 24.4983991453592, 
24.4292324356466, 24.8179824927011, 24.7243948463075, 24.5086534543966, 
24.2818632071983, 24.4567195220259, 24.8402224356034, 24.6574465515086, 
24.5440715673563, 23.482670620977, 24.9979594684914, 24.5452453980747, 
24.9271462811494, 24.7443215819253, 25.8929839790805, 25.1801908261063, 
25.2079308058908, 25.0722425561207, 25.4554644289799, 25.4548979078736, 
25.0756772250287)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-42L)) 

已尝试的无效方案 #

方案1：initComplete回调修改样式 #

运行后列头始终显示主题默认黑色，未达到预期，代码如下：

library(shiny)
library(shinythemes)
library(htmltools)
library(DT)
library(tidyverse)

ui =   navbarPage(
                  tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
                  title = div("Table"),
                  theme = shinytheme("cyborg"),
                  tabPanel("Project",
                           icon = icon("info"),
                           div(p(h1("Instructions:", style ="color:black"),style="text-align: justify;")),
                           p("1. The user can add data to a table.", style="color:black"),
                           uiOutput("all"),
                  sidebarLayout(
                    sidebarPanel(
                      actionButton("addData", "Add Details"),
                      ),
                    mainPanel(
                      downloadButton("download1","Download data as csv"),                
                      DTOutput("contents"),
                      tags$script(HTML("
           Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
               var target = $('#tableContainer .dataTable');
               target.dataTable().api().page('last').draw(false);
           });
           "))),
                    )
                    )
)

server <- function(input, output, session) {

  myData = df
  
   user_table =
     myData %>% 
      slice(1) %>% 
    gather(key = "column_name", value = "value") %>%
    mutate(value = "") %>%
    spread(column_name, value) %>%
    select(colnames(myData))
   
   output$contents =
     renderDT(myData,
              server = FALSE,
              editable = TRUE,
              options = list(lengthChange = TRUE,
                             initComplete = JS(
                               "function(settings, json) {",
                               "$(this.api().table().header()).css({'color': '#34a8eb'});",
                               "}"),
              rownames = FALSE))
   
   proxy = dataTableProxy(outputId = "contents")
   
   observeEvent(eventExpr = input$addData, {
     proxy %>% 
       addRow(user_table)
     session$sendCustomMessage('messageJumpToLast', 'some payload here, if needed')
   })
  
}

shinyApp(ui = ui, server = server)

失效原因：回调代码仅修改了color（文字颜色）属性，未设置background-color（背景色）；同时cyborg主题自带的表头样式优先级更高，JS注入的样式会被默认覆盖。

方案2：自定义表格容器 #

参考DT自定义表格教程编写了表头样式代码，但未明确整合方式，代码如下：

header.style = "th { font-family: 'Arial'; font-weight: bold; color: black; background-color: #34a8eb;}"
header.names = c(" ", colnames(df))
my.container = withTags(table(
style(type = "text/css", header.style),
thead(
tr(
lapply(header.names, th, style = "text-align: center; border-right-width: 1px; border-right-style: solid; border-right-color: white; border-bottom-width: 1px; border-bottom-style: solid; border-bottom-color: white")
)
)
))

正确实现方式 #

方法1：CSS覆盖（最简便，推荐） #

不需要编写JS回调，也不需要自定义容器，直接修改UI中的CSS样式，通过!important提升样式优先级覆盖主题默认配置即可：

• 将UI中原有的tags$style内容替换为以下代码：

tags$style("
  table, .table {color: unset;} 
  .dataTable th, .datatables input {color: white}
  /* 设置列头背景色 */
  .dataTable thead th {
    background-color: #34a8eb !important;
  }
")

• 删除renderDT中原有无效的initComplete回调配置，重新运行应用即可生效。

方法2：使用自定义容器 #

如果需要更灵活地定制表头样式，可以使用预先写好的自定义容器，注意两点调整：

• 因为设置了rownames = FALSE，不需要预留行名列头，把header.names开头的空字符串删掉，改为header.names = colnames(df)
• 在renderDT中传入container = my.container参数即可，示例：

output$contents =
  renderDT(myData,
           server = FALSE,
           editable = TRUE,
           container = my.container, # 传入自定义容器
           options = list(lengthChange = TRUE),
           rownames = FALSE)

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