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

Question

I have a DT datatable that has cells colored according to a different variable. When you click on a row, it highlights values in a corresponding plot, exactly like in the example here . However, when you select a row, the new color that highlights the row overrides my existing colors. I'd like for the row to be highlighted, but the individual cell to maintain its color if it was already colored.

The screenshots below show what I'm getting and what I want. I modified Yihui's code to make a reproducible example below the screenshots. Any help would be appreciated!

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

You can define a CSS class for the background color ( red below) and add it to the desired cells with a rowCallback . Then add this CSS:

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

The app:

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

You can make this happen with some custom CSS. Add this code block to your fluidPage :

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

You could also drop that CSS snippet into a standalone file and place it in the www directory alongside your app file(s). See here for more Shiny CSS info .

Live Demo