閃亮的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信息 。

現場演示