实施例

Question

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

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样式等

细节着色在Shiny Rendertable

1 个答案:

实施例