Shiny Rendertable 中的单元格着色

Question

我有一个非常简单的问题。我正在尝试有条件地为shinyrenderTable 的某些单元格着色。出于某种原因，下面的方法是将一个单元格向右着色，并将行中的单元格也推到一列上：

test <- data.frame(test1 = c(1:3), test2 = c(4:6))
test[test$test1 == 1, "test1"] <- '<td style="background-color:red">'

library(shiny)

ui <- shinyUI(fluidPage(
   tableOutput("tt")
   )
)

server <- shinyServer(function(input, output) {

   output$tt <- renderTable({
     test
   }, sanitize.text.function = function(x) x)
})

shinyApp(ui = ui, server = server)

这是一个错误吗？当我检查 HTML 输出时，我看到它留下了一个空白的<td> </td> 单元格并创建了一个新的<td style="background-color:red">。我也试过了：

test[test$test1 == 1, "test1"] <- '<td bgcolor="#FF0000">1</td>'

其他样式有效：

test[test$test1 == 1, "test1"] <- "<strong>1</strong>"

我试图避免更复杂的解决方案，例如：

R shiny color dataframe

这是否太简单而无法工作？非常感谢。

Answer 1

如果您只想使用 renerTable 进行操作，可以尝试将 div 添加到 td 中

示例

（但您可能需要一些 css 操作来获得相同的文本位置）

test <- data.frame(test1 = c(1:3), test2 = c(4:6))
test[test$test1 == 1, "test1"] <- '<div style="width: 100%; height: 100%; z-index: 0; background-color: green; position:absolute; top: 0; left: 0; padding:5px;">
<span>1</span></div>'

library(shiny)

ui <- shinyUI(fluidPage(
  tableOutput("tt"),
  tags$head(tags$style("#tt td{
                       position:relative;
                       };
                       
                       "))
  )
  )

server <- shinyServer(function(input, output) {
  
  output$tt <- renderTable({
    test
  }, sanitize.text.function = function(x) x)
})

shinyApp(ui = ui, server = server) 

在 DT 中你可以这样做：

test <- data.frame(test1 = c(1:3), test2 = c(4:6))

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
  DT::dataTableOutput("tt")
)
)

server <- shinyServer(function(input, output) {
  
  output$tt <- DT::renderDataTable({
    datatable(test)%>%formatStyle("test1",backgroundColor=styleEqual(1, "red"))
  })
})

shinyApp(ui = ui, server = server)

正如您在 DT 版本中看到的，您不需要任何 css 样式等