闪亮的DT选择行，保持单元格颜色

Question

我有一个DT数据表，其中的单元格根据不同的变量着色。 单击某一行时，它会突出显示相应图表中的值，与此处的示例完全相同。 但是，当您选择一行时，突出显示该行的新颜色将覆盖我现有的颜色。 我希望突出显示行，但如果已经着色，则单个单元格保持其颜色。

下面的截图显示了我得到的和我想要的东西。 我修改了Yihui的代码，在屏幕截图下面做了一个可重现的例子。 任何帮助，将不胜感激！

library(shiny)
library(DT)

ui <- fluidPage(

  title = 'Select Table Rows',

  fluidRow(
    column(6, DT::dataTableOutput('x1')),
    column(6, plotOutput('x2', height = 500))
  )


)

server <- function(input, output) {
  cars <- cars %>% 
    mutate(low_speed = ifelse(speed < 5, 1, 0))

  output$x1 <- renderDataTable({
    datatable(cars,
              options = list(columnDefs = list(list(targets = 3,
                                                    visible = FALSE)))) %>% 
      formatStyle("speed", "low_speed",
                  backgroundColor = styleEqual(c(0, 1), 
                                             c("transparent", "#E34755")))
  })

  # highlight selected rows in the scatterplot
  output$x2 <- renderPlot({
    s <- input$x1_rows_selected
    par(mar = c(4, 4, 1, .1))
    plot(cars[ ,-3])
    if (length(s)) points(cars[s, , drop = FALSE], pch = 19, cex = 2)
  })



}
shinyApp(ui, server)

Answer 1

您可以为背景颜色定义CSS类（下面的red ），并使用rowCallback将其添加到所需的单元格。 然后添加这个CSS：

.red {
  background-color: #e34755;
}
table.dataTable tr.selected td.red {
  background-color: #e34755 !important;
}

该应用程序：

library(shiny)
library(DT)

rowCallback <- c(
  "function(row, dat, displayNum, index){",
  "  if(dat[1] < 5){",
  "    $('td:eq(1)', row).addClass('red');",
  "  }",
  "}"
)

css <- "
.red {
  background-color: #e34755;
}
table.dataTable tr.selected td.red {
  background-color: #e34755 !important;
}
"

ui <- fluidPage(

  tags$head(
    tags$style(HTML(css))
  ),

  title = 'Select Table Rows',

  fluidRow(
    column(6, DTOutput('x1')),
    column(6, plotOutput('x2', height = 500))
  )
)

server <- function(input, output) {

  output$x1 <- renderDT({
    datatable(cars,
              options = list(
                columnDefs = list(list(targets = 3,visible = FALSE)),
                rowCallback = JS(rowCallback)
              )
    )
  })

  # highlight selected rows in the scatterplot
  output$x2 <- renderPlot({
    s <- input$x1_rows_selected
    par(mar = c(4, 4, 1, .1))
    plot(cars[ ,-3])
    if (length(s)) points(cars[s, , drop = FALSE], pch = 19, cex = 2)
  })
}

shinyApp(ui, server)

Answer 2

您可以使用一些自定义CSS实现此目的。 将此代码块添加到fluidPage ：

  tags$head(
    tags$style(
      HTML(
      "table.dataTable tbody tr.selected td {
       color: white !important;
       background-color: #E34755 !important;}"
      )
      )
  ),

您还可以将该CSS片段放入独立文件中，并将其放在应用程序文件旁边的www目录中。 在这里查看更多有光泽的CSS信息 。

现场演示