R闪亮的renderTable更改单元格颜色

Question

我有一张表格，想根据 X(=6) 中不同深浅的蓝色的值 (0-100) 为每个单元格着色。表格显示在 TabPanel 中。

目前我正在使用 shinyjs 调用一个 javascript 函数，该函数选择我的表格并将 CSS 样式添加到 <td> 标签，具体取决于值范围。

问题是，在第一次加载表格时（点击 TabPanel），没有颜色显示，只有在重新加载后才显示。

所以我要么在 R 中寻找解决方案（不需要额外的 Javascript），要么在寻找自动重新加载 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) 

更新 最后我还是选择了 JavaScript 解决方案，但使用了闪亮的特定 js 事件来获得预期的效果：

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

Answer 1

我认为最好的解决方案是使用DT 库功能。 该表格更美观，并且还保留了可滚动表格的功能。两者都立即缺少tableHTML。

服务器包含renderDataTable 函数，用户可以在其中有条件地格式化表格：

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 只是调用dataTableOutput:

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

显示结果：

shinyApp(ui = ui, server = server) 

你会得到： 更多示例：https://rstudio.github.io/DT/010-style.html

Answer 2

您可以使用tableHTML 来创建表格并有条件地对其进行样式设置。

library(shiny)
library(tableHTML)

更改ui 以使用tableHTML 的输出功能：

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

然后使用render_tableHTML() 渲染其中生成的表格。

您可以使用函数tableHTML() 创建一个纯 HTML 表格。然后您可以使用add_css_conditional_column() 创建条件（在本例中为between）来更改背景颜色（注意：您也可以使用其他css。我在示例中使用#f6f6f6 而不是white，因为你不会看到输出的差异）

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))

  })

})

最终结果是：

shinyApp(ui = ui, server = server) 

您可以在vignettes 中找到有关如何使用tableHTML 的更多详细信息。