0

There are similar questions asked before R Shiny DataTable selected row color Background color of DT::datatable in shiny DT datatable selected row color: inconsistent behavior on IE and chrome

However none of the solutions mentioned worked in my case.

I put a DT table in the sidebar of a dashboard, because I want to use that table to control behavior of other pages and would like the table to be visible all the times.

Here is the sample code

if (!require("pacman")) install.packages("pacman")
pacman::p_load(shiny, shinydashboard, DT, data.table, ggplot2)
sidebar_width <- 260
header <- dashboardHeader(title = "Dashboard", 
                          titleWidth = sidebar_width, 
                          dropdownMenuOutput("messageMenu"))
sidebar <- dashboardSidebar(
  width = sidebar_width,
  sidebarMenu(
    id = "tabs",
    menuItem("menu 1", icon = icon("bar-chart-o"), tabName = "charts"
             ),
    br(), br(), br(),
    fluidRow(
      # tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "www/styles.css")),
      column(11, offset = 0, DTOutput("control_dt"))
    )
  ))
body <- dashboardBody()
ui <- dashboardPage(header, sidebar, body,skin = "green")
server <- function(input, output, session) {
  output$control_dt <- renderDT({
    DT::datatable(mtcars[1:10, 1:2], 
                  selection = list(mode = "multiple",
                                       selected = 1,
                                       target = 'row'),
                  options = list(
                    columnDefs = list(list(className = 'dt-center',
                                           targets = "_all")),
                    dom = "t",
                    pageLength = 10),
                  style = "bootstrap",
                  class = "table-condensed",
                  rownames = TRUE
                  ) %>%
      formatStyle("cyl", target = 'row',
                  color = styleEqual(c(4, 6, 8),
                                     c("red", "gray", "yellow")))
  })
}
shinyApp(ui, server)

My problem is that I used different color for rows depend on value of a column. When a row was selected, it will always use a fixed background color and color, so my customized color is lost.

Because the customized color is dynamically calculated from the data/code, I cannot just hardcode it in the css. The selector I found in app is different from the previous answers because I used bootstrap styles for DT, which is

.table.dataTable tbody td.active, .table.dataTable tbody tr.active td {
    background-color: rgb(0, 117, 176);
    color: white;
}

Now I tried with a customized css which can replace the background color, however I don't know how to unset the white color and let the calculated color take effect. I tried color:unset which didn't work.

The specified color is generated by DT format functions which used datatables callback, then it got defined in row element:

<tr role="row" class="even active" style="color: rgb(252, 141, 98);">
<td class=" dt-center">B</td>
<td class=" dt-center">20</td>
<td class=" dt-center">4</td></tr>
dracodoc
  • 2,603
  • 1
  • 23
  • 33

2 Answers2

0

The only solution I have consists in using a row callback to add a class to the td, and set !important in the CSS.

Update: I have an easier solution, see at the bottom.

library(shiny)
library(shinydashboard)
library(DT)

rowCallback <- c(
  "function(row, data, displayNum, displayIndex){", 
  "  var x = data[2];", # 2 is the index of the 'cyl' column
  "  if(x == 4){",
  "    $('td', row).addClass('red');",
  "  } else if(x == 6){",
  "    $('td', row).addClass('gray');",
  "  } else if(x == 8){",
  "    $('td', row).addClass('yellow')",
  "  }",
  "}"
)

css <- "
table.dataTable tbody tr td.red {color: red !important}
table.dataTable tbody tr td.gray {color: gray !important}
table.dataTable tbody tr td.yellow {color: yellow !important}
"

sidebar_width <- 260
header <- dashboardHeader(title = "Dashboard", 
                          titleWidth = sidebar_width, 
                          dropdownMenuOutput("messageMenu"))

sidebar <- dashboardSidebar(
  width = sidebar_width,
  sidebarMenu(
    id = "tabs",
    menuItem("menu 1", icon = icon("bar-chart-o"), tabName = "charts"
    ),
    br(), br(), br(),
    fluidRow(
      tags$head(tags$style(HTML(css))),
      column(11, offset = 0, DTOutput("control_dt"))
    )
  ))

body <- dashboardBody()

ui <- dashboardPage(header, sidebar, body,skin = "green")

server <- function(input, output, session) {
  output$control_dt <- renderDT({
    DT::datatable(mtcars[1:10, 1:2], 
                  selection = list(mode = "multiple",
                                   selected = 1,
                                   target = 'row'),
                  options = list(
                    rowCallback = JS(rowCallback),
                    columnDefs = list(list(className = 'dt-center',
                                           targets = "_all")),
                    dom = "t",
                    pageLength = 10),
                  style = "bootstrap",
                  class = "table-condensed",
                  rownames = TRUE
    ) 
  })
}

shinyApp(ui, server)

Update

I've just found an easier solution, which does not require a row callback:

css <- "table.table.dataTable tbody tr.active td {color: unset}"

fluidRow(
  tags$head(tags$style(HTML(css))),
  column(11, offset = 0, DTOutput("control_dt"))
)

and use the friendly formatStyle:

......
) %>%
  formatStyle("cyl", target = 'row',
              color = styleEqual(c(4, 6, 8),
                                 c("red", "gray", "yellow")))
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
  • Use rowcallback is not ideal because that basically reimplement formatStyle. I'm using formatStyle already. I tired your solution(I actually tried before) but still got the color overridden in selection. – dracodoc Jun 12 '19 at 19:15
  • @dracodoc With rowcallBack you can add some classes, which is not possible with formatStyle. And this allows to use !important. Both solutions work for me, which one does not work for you ? I'm using Chrome, and you ? – Stéphane Laurent Jun 12 '19 at 19:23
  • OK, got it, you used rowcallBack to added class to each row, then the css for that row got higher priority. I tried the 2nd solution but the selected row still override the color. In your 2nd solution I didn't see any difference in the formatStyle part from my orignial version. Is there anything I'm missing? – dracodoc Jun 12 '19 at 19:29
  • @dracodoc That's strange, maybe the browser ? Have you tried with Chrome ? I don't think you're missing something, there's just the css to add. – Stéphane Laurent Jun 12 '19 at 19:31
  • Works in Firefox too. – Stéphane Laurent Jun 12 '19 at 19:33
  • I'm using chrome. If the css line is the only thing added, is "table.table.dataTable" a valid selector? – dracodoc Jun 12 '19 at 19:34
  • @dracodoc Yes this is valid. This select the 'table' elements having classes 'table' and 'dataTable'. I can see this CSS with the inspector tools. – Stéphane Laurent Jun 12 '19 at 19:36
  • Strange, I still didn't see it take effect. Hope others can test it. – dracodoc Jun 12 '19 at 19:42
0

I found a subtle difference in other similar table which didn't have this problem.

When using formatStyle to target a row, the row div got the color style, which was not applied after a row was selected in bootstrap style.

If formatStyle was used to target a column, the specific cell got the color style which will have highest priority and keep the color.

So I can format every column specifically using one column value, then the color will not be overridden by the selection.

... %>%
    formatStyle("cyl", 
                  color = styleEqual(c(4, 6, 8),
                                     c("red", "gray", "yellow"))) %>%
      formatStyle("mpg", valueColumns = "cyl",
                  color = styleEqual(c(4, 6, 8),
                                     c("red", "gray", "yellow")))

This solved the problem but I'm not satisfied with it so I will not mark it as answer yet. If there is any better solution I'll mark that as answer.

Update: per @Stéphane Laurent suggestion, we can just use a simpler syntax since the parameter can take a vector.

... %>%
      formatStyle(c("cyl", "mpg"), valueColumns = "cyl",
                  color = styleEqual(c(4, 6, 8),
                                     c("red", "gray", "yellow")))
dracodoc
  • 2,603
  • 1
  • 23
  • 33