Change selected cell background color in a Shiny DT table based on rules?-CodePudding

Is it possible to change the background color of user-selected cells in a Shiny app DT table based on programmatic rules and reactive values? I can customize the color of ALL user-selected cells with tags$style in the code below. However, I would like the table to be "When the user selects a cell, change that cell's background color to white in odd-numbered rows or blue in even-numbered rows -- unless the value of the cell above is 'X', then don't change it at all." (really there is a reason for this!) Of course the data frame will change based on user input, but those inputs are not included here to save space.

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Sample app"),
  tags$style(HTML('table.dataTable td.selected {background-color: blue !important;}')),
  fluidRow(
    column(width = 10,
           DTOutput("maintable")
    ) ) )      

server <- function(input, output, session) {
  
  mydf <- reactive({data.frame(
    matrix(" ", nrow = 10, ncol = 10, dimnames = list(
      seq.int(1,10,1),
      seq.int(1,10,1))
    ))
  })
  
  output$maintable <- renderDT(
    DT::datatable(mydf(), selection = list(target = 'cell'), class = 'table-bordered compact', options = list(
      dom='t',ordering=F, pageLength = nrow(mydf)
    )))
}
shinyApp(ui = ui, server = server)

CodePudding user response：

The first part - highlighting colour by odd/even row - I've taken advantage of the "stripe" class and adding in some extra CSS to remove the stripes, but it does include an extra class to say whether a row is even or odd which helps choose the different colours.

For the if cell = "X" I've added some dummy columns to reference adding in a "no-highlight" class so that when clicked it doesn't change colour.

www/style.css

/* Removes background colour of stripes */
table.dataTable.stripe tbody tr.odd, table.dataTable.stripe tbody tr.even {
  background-color: #cccccc; 
}

table.dataTable tr.odd td.selected:not(.no-highlight) {
  background-color: #ffffff !important;
}

table.dataTable tr.even td.selected:not(.no-highlight) {
  background-color: blue !important;
}

table.dataTable tbody tr td.selected.no-highlight {
  background-color: #cccccc !important;
}

app.R

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Sample app"),
  tags$link(href = "style.css", rel = "stylesheet"),
  
  fluidRow(
    column(
      width = 10,
      DTOutput("maintable")
    ) 
  ) 
)      

server <- function(input, output, session) {
  
  mydf <- reactive(
    data.frame(
      matrix(
        sample(c("X", " "), 100, TRUE), 
        nrow = 10, 
        ncol = 10, 
        dimnames = list(
          seq.int(1, 10, 1),
          seq.int(1, 10, 1)
        )
      )
    )
  )
  
  trans_df <- reactive(
    cbind(
      mydf(), 
      rbind(" ", mydf()[seq(1, nrow(mydf()) - 1), ])
    )
  )
  
  output$maintable <- renderDT(
    DT::datatable(
      trans_df(), 
      selection = list(target = "cell"), 
      class = "table-bordered compact stripe", 
      options = list(
        dom = "t",
        ordering = FALSE, 
        pageLength = nrow(mydf()),
        columnDefs = list(
          list(
            targets = seq(ncol(mydf()))   ncol(mydf()),
            visible = FALSE
          ),
          list(
            targets = seq(ncol(mydf())),
            createdCell = JS(paste0(
              "function (td, cellData, rowData, row, col) {",
                "if (rowData[col   ", ncol(mydf()), "] === 'X') {",
                  "$(td).addClass('no-highlight');",
                "}",
              "}"
            ))
          )
        )
      )
    )
  )
}

shinyApp(ui = ui, server = server)