根据规则更改 Shiny DT table 中选定的单元格背景颜色?

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

是否可以根据编程规则和反应值更改闪亮应用程序 DT table中用户选择的单元格的背景颜色? 我可以在下面的代码中使用 tags$style 自定义 ALL 用户选择的单元格的颜色。但是,我希望 table 是“当用户选择一个单元格时,将该单元格的背景颜色更改为奇数行的白色或偶数行的蓝色——除非上面单元格的值是'X',那就别改了。” (这真的是有原因的!)当然,数据框会根据用户输入而改变,但是这里不包括这些输入以保存 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)

第一部分 - 通过 odd/even 行突出显示颜色 - 我利用了“条纹”class 并添加了一些额外的 CSS 来移除条纹,但是它确实包含一个额外的 class 来说明一行是偶数还是奇数,这有助于选择不同的颜色。

对于 if cell = "X",我添加了一些虚拟列以参考添加“no-highlight”class,以便在单击时不会改变颜色。

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)