R shiny renderTable change cell colors

问题

I have a table and want to color every cell depending on the value (0-100) in X(=6) different shades of blue. The table is shown in a TabPanel.

Currently I am using shinyjs to call a javascript function which selects my table and add CSS styling to the <td> tags, depending on the value range.

The Problem is, that on the first loading of the table (click on TabPanel), no color is shown, only after reloading again.

So I am either looking for a solution in R (without the need for extra Javascript), or a method to automatically reload a Table/TabPanel.

library(shiny)

ui <- shinyUI(fluidPage(
    tableOutput("dataTable")
  ))

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

  output$dataTable <- renderTable({
    data <- getDataFromSomeWhere();
    //Some operations on data
    data
    //I want to color every table cell, depening on value (f.e. 0-5 = white, 10-20 = light blue ...)
  }, rownames = TRUE, colnames = TRUE)

shinyApp(ui = ui, server = server) 

UPDATE In the end I stayed with the JavaScript solution, but used the shiny specific js events to get the desired effect:

$(document).on("shiny:value", function(e) {
  if (e.name == "myComponent") {
    e.preventDefault();
    $('#myComponent').html(e.value);
    //color code etc.
}

回答1:

You can use tableHTML to create a table and style it conditionally.

library(shiny)
library(tableHTML)

Change the ui to use the output function from tableHTML:

ui <- shinyUI(fluidPage(
  tableHTML_output("dataTable")
))

Then use render_tableHTML() to render the table that is produced within.

You can create a plain HTML table using the function tableHTML(). You can then use add_css_conditional_column() to create conditionals (in this case between) to change the background colour (Note: you could use other css as well. I have used #f6f6f6 instead of white in the example, since you would not see a difference in the output)

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

  getDataFromSomeWhere <- reactive({
    mtcars
  })

  output$dataTable <- render_tableHTML({
    data <- getDataFromSomeWhere();
    # //Some operations on data
    data %>% 
      tableHTML(rownames = TRUE) %>% 
      add_css_conditional_column(conditional = 'between',
                                 between = c(0, 5),
                                 css = list(c('background-color'),
                                            c('#f6f6f6')),
                                 columns = 1:ncol(data)) %>% 
      add_css_conditional_column(conditional = 'between',
                                 between = c(10, 20),
                                 css = list(c('background-color'),
                                            c('lightblue')),
                                 columns = 1:ncol(data))

  })

})

The final result is:

shinyApp(ui = ui, server = server) 

You can find more details on how to use tableHTML in the vignettes.

回答2:

The best solution in my opinion is to use the DT library functionality. The table is more aesthetically pleasing and also keeps the scrollable table functionality. Both are immediately lacking in tableHTML.

Server contains the renderDataTable function where the user can conditionally format the table:

server <- shinyServer(function(input, output) {
 output$beautifulTable <- DT::renderDataTable({
    
    # display top 5 rows at a time
    options(DT.options = list(pageLength = 5))
    
    # example dataframe
    df = as.data.frame(cbind(matrix(round(rnorm(50), 3), 10), sample(0:1, 10, TRUE)))
    
    # set conditions and return the beautiful table
    return(datatable(df) %>% formatStyle('V6', backgroundColor = styleEqual(c(0, 1), c('gray', 'yellow'))))
      
  })
}

UI simply calls dataTableOutput:

ui <- shinyUI(fluidPage(
  # display the beautiful table
  dataTableOutput("beautifulTable")
))

Display result with:

shinyApp(ui = ui, server = server) 

And you will get: More examples here: https://rstudio.github.io/DT/010-style.html

来源：https://stackoverflow.com/questions/50798941/r-shiny-rendertable-change-cell-colors