在闪亮的 DT 行中添加背景颜色

Posted 2023-03-24

【中文标题】在闪亮的 DT 行中添加背景颜色

【英文标题】：Add background color to DT rows in shiny

【发布时间】：2021-11-15 05:20:22

【问题描述】：

我有一些代码可以创建一个带有单选按钮的 DT 表。最重要的是，我需要为每一行添加特定的颜色。我一直在尝试使用 formatStyle 为每一行添加不同的颜色，但我没有得到正确的语法。

这是工作代码：

library(shiny)
library(DT)

c1 = "This is comment 1"
c2 = "This is comment 2"
c3 = "This is comment 3"
c4 = "This is comment 4"
c5 = "This is comment 5"
comments1 = list(c1,c2,c3,c4,c5)


m1 = matrix(
 as.character(1:5), nrow = 5, ncol = 1, byrow = FALSE,
 dimnames = list(comments1, LETTERS[1])
)
for (i in seq_len(ncol(m1))) 
 m1[, i] = sprintf(
   '<input type="radio" name="%s" value="%s"/>',
   'AValue', m1[,i]
 )


callback1 <- c(
 "var LETTERS = ['AValue'];",
 "for(var i=0; i < LETTERS.length; ++i)",
 "  var L = LETTERS[i];",
 "  $('input[name=' + L + ']').on('click', function()",
 "    var name = $(this).attr('name');",
 "    var value = $('input[name=' + name + ']:checked').val();",
 "    Shiny.setInputValue(name, value);",
 "  );",
 ""
)



ui <- fluidPage(
   title = 'Radio buttons in a table',
   DT::dataTableOutput('foo1'),
   verbatimTextOutput('sel1'),
)

server <- function(input, output, session) 

   output$foo1 = DT::renderDataTable(
     m1, escape = FALSE, selection = 'none', server = FALSE,
     options = list(dom = 't', paging = FALSE, ordering = FALSE),
     callback = JS(callback1),
   ) 

   output$sel1 = renderPrint( 
     input[["AValue"]]
   )


shinyApp(ui, server)

以下是我尝试过的一些调用的不同变体。

#formatStyle needs to be called on DT:datatable() 
    #Test adding formatStyle
    output$foo1 <- DT::renderDataTable(
      dat <- datatable(m1, escape = FALSE, selection = 'none', 
        options = list(dom = 't', paging = FALSE, ordering = FALSE))
      callback = JS(callback1)  %>% formatStyle(0, target='row', backgroundColor = styleEqual(3,'red'))
    ) 

或

    #Test adding formatStyle
    output$foo1 <- DT::renderDataTable(    
      DT::datatable(m1,escape = FALSE, selection = 'none', 
        options = list(dom = 't', paging = FALSE, ordering = FALSE, callback = JS(callback1))
        %>% formatStyle(0, target='row', backgroundColor = styleEqual(3,'red')))
    ) 

任何帮助将不胜感激。 谢谢！

【参考方案1】：

您需要将表格作为formatStyle 的参数传递。要在 renderDataTable 中执行此操作，您可以使用 datatable 函数。

您为行分配颜色的条件似乎与任何行都不匹配。您需要在列中添加一些内容。下面是一个示例，其中当第 0 列中的内容等于 "This is comment 3" 时，整行具有红色背景。

  output$foo1 = DT::renderDataTable(
    DT::datatable(
      m1, escape = FALSE, selection = 'none',
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS(callback1)
    ) %>% formatStyle(0, target='row', backgroundColor = styleEqual('This is comment 3','red'))
    , server = FALSE
  )

【讨论】：

有没有办法以菊花链格式样式一起为多行添加颜色，例如：%>% formatStyle(0, target='row', backgroundColor = styleEqual(3,'red')) %>% formatStyle(0, target='row', backgroundColor = styleEqual(2,'yellow'))

试试%>% formatStyle(0, target='row', backgroundColor = styleEqual(c(2, 3), c('yellow','red')))

【参考方案2】：

也许您可以使用 row_numbers 定义一个新列，并为感兴趣的行分配颜色。您可以使row_num 列不可见。试试这个

mycolors <- c('green','pink','red','yellow','orange')
  output$foo1 = DT::renderDataTable(
    m2 <- as.data.frame(m1) %>% dplyr::mutate(row_num = 1:n())
    
    datatable( m2, escape = FALSE, 
               selection = 'none', 
               extensions = c("Select", "Buttons"), 
               callback = JS(callback1),  ###   needs double-click to select the radiobutton
               options = list(dom = 't', paging = FALSE, ordering = FALSE,
                              columnDefs = list(list(visible=FALSE, targets=2))
                              )
               )   %>% formatStyle(2, 
                                   target='row',
                                   backgroundColor = styleEqual(c(1:5),mycolors))
      
    , server = FALSE,
    #callback = JS(callback1)  ###  does not recognize input[["AValue"]]
  )
  

【讨论】：

我在 mutate 中的 n() 函数上出现错误。这是在其他地方定义的吗？

我将其设置为行数 5。row_num=1:5 似乎可以工作

n() 来自dplyr 包。请在您的 RStudio 控制台中尝试?n()。