基于闪亮用户输入的数据表单元格的颜色背景

Question

我正在使用来自 DT 库的数据表来获取来自我的 Shinyapp 的用户输入。 现在我想根据用户输入为数据表单元格的背景着色。

这是我目前得到的代码：

library(shiny)
library(data.table)
library(DT)
shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    DT::dataTableOutput('foo'),
    verbatimTextOutput('sel'), verbatimTextOutput('x2')

  ),
  server = function(input, output, session) {

    x <- data.table( 'Breed Split' = paste0("F",rep(0:16)), Friesian = rep(1,17), Cross = rep(2,17), Jersey = rep(3,17) ,
                     checked=c(rep("Friesian",9),rep("Cross",5),rep("Jersey",3))
    )

    x[, Friesian := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Friesian],ifelse("Friesian"==x[, checked],"checked" ,""))]
    x[, Cross := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Cross],ifelse("Cross"==x[, checked],"checked" ,"" ))]
    x[, Jersey := sprintf( '<input type="radio" name="%s" value="%s" %s/>', `Breed Split`, x[, Jersey] ,ifelse("Jersey"==x[, checked],"checked" ,""))]

    output$foo = DT::renderDataTable(
      x[,-c("checked")], escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS("table.rows().every(function(i, tab, row) {
                    var $this = $(this.node());
                    $this.attr('id', this.data()[0]);
                    $this.addClass('shiny-input-radiogroup');
  });
                    Shiny.unbindAll(table.table().node());
                    Shiny.bindAll(table.table().node());")
    )

    output$sel = renderPrint({ sapply(x$`Breed Split`, function(i) input[[i]]) })

    }
    )

所选品种的单元格背景颜色：

弗里斯兰：红色
十字：绿色
球衣：蓝色

也就是说，我需要在DT::renderDataTable内申请formatStyle()

Answer 1

我创建了一个小示例，其中选定单元格的背景颜色会根据用户输入而变化。我希望这会有所帮助！

服务器.R

library(shiny)
library(DT)

shinyServer(function(input, output, session) {

  dataReactive <- reactive({
      return(mtcars[mtcars$gear==input$gear,])
  })

  output$table1 <- DT::renderDataTable({
    df <- head(mtcars,100)

      if(input$gear==1) color="red"
      if(input$gear==2) color="blue"
      if(input$gear==3) color="green"
      if(input$gear==4) color="lightblue"

    DT::datatable(df) %>% formatStyle(c("mpg", "cyl", "disp"),
                                      backgroundColor = color)
  })

})

ui.R

shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
 selectInput("gear","Select gear:", choices = c(1,2,3,4))
    ),
    mainPanel(
                DT::dataTableOutput("table1")
    )
  )
))