基於閃亮用戶輸入的數據表單元的顏色背景

Question

我正在使用來自我的Shinyapp用戶輸入的DT庫的數據表。 現在我想基於用戶輸入給數據表單單元的背景着色。

下面是我迄今爲止得到的代碼：

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]]) }) 

    } 
    ) 

格背景顏色選擇品種：

黑白花：紅
十字：綠色
球衣：藍色

換句話說，我需要申請formatStyle()DT::renderDataTable

Answer 1

我創建了一個小例子，其中所選單元格的背景顏色根據用戶輸入而改變。我希望這有幫助！

server.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") 
    ) 
) 
))