javascriptrshinydthtmltools

Change column header color


I have a Shiny app that displays a DT table. I would like to be able to change the color of the column headers (not the column header text color) from black to something else say #34a8eb. I tried the following two approaches.

How can I do this?

Sample data (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)) 

Method 1: This method doesn't change header color as it's still black.

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

# Define UI for application that draws a histogram
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"),
                      ## include JS code via tags$script(HTML(...)) to go to the last page when the `addData` button is clicked
                      tags$script(HTML("
           Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
               // select the target table via its container ID and class:
               var target = $('#tableContainer .dataTable');
               // display last page:
               target.dataTable().api().page('last').draw(false);
           });
           "))),
                    )
                    )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  myData = df
  
  # Create an 'empty' tibble 
   user_table =
     myData %>% 
      slice(1) %>% 
    # Transpose the first row of test into two columns
    gather(key = "column_name", value = "value") %>%
    # Replace all values with ""
    mutate(value = "") %>%
    # Reshape the data from long to wide
    spread(column_name, value) %>%
    # Rearrange the column order to match that of test
    select(colnames(myData))
   
   # Display data as is
   output$contents =
     renderDT(myData,
              server = FALSE,
              editable = TRUE,
              options = list(lengthChange = TRUE,
                             # JS to change header color
                             initComplete = JS(
                               "function(settings, json) {",
                               "$(this.api().table().header()).css({'color': '#34a8eb'});",
                               "}"),
              rownames = FALSE))
   
   # Store a proxy of contents 
   proxy = dataTableProxy(outputId = "contents")
   
   # Each time addData is pressed, add user_table to proxy
   observeEvent(eventExpr = input$addData, {
     proxy %>% 
       addRow(user_table)
     session$sendCustomMessage('messageJumpToLast', 'some payload here, if needed')
   })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Method 2: Based on step 7 here, but I don't know where to fit this in the code and if it requires some further steps.

header.style = "th { font-family: 'Arial'; font-weight: bold; color: black; background-color: #34a8eb;}"
header.names = c(" ", colnames(df))
# The container parameter allows us to design the header of the table using CSS
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")
)
)
))

Solution

  • Change from "color" to "background-color" in Method 1.

    initComplete = JS(
      "function(settings, json) {",
      "$(this.api().table().header()).css({'background-color': '#34a8eb'});",
      "}"),
    

    "color" will set text color, and "background-color" will set background color.