Блестящий с 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 .

Live Demo