R/Shiny：框的颜色取决于选择

Question

我尝试在闪亮中创建动态框。 我们可以用 (status = "warning" or "info" etc.) 来改变盒子的状态（颜色） 我想根据选择输入的选择（动态）更改此框的颜色：

https://image.noelshack.com/fichiers/2018/32/2/1533638864-v1.png https://image.noelshack.com/fichiers/2018/32/2/1533638864-v2.png

代码如下所示：

SelectInput("s010102i", label = NULL, 
 choices = list("Value 1" = 1, "Value 2" = 2, "Value 3" = 3), 
 selected = 1) ,width = 12, background = "blue", status = "info")),                                column(4,

我们需要通过一个变量来改变状态中的“信息”。但是当我尝试将变量放在 ui 端时，它不起作用，当我像 output$s010102i 这样经过服务器时...状态不等于输出中的“信息”，而是：

ERROR: Invalid status: <div id="s010102o" class="shiny-html-output"></div>. Valid statuses are: primary, success, info, warning, danger.

我怎样才能动态放置它？以及如何改变一个变量的选择？

非常感谢！

编辑 -> 这里有一个可利用的代码来理解：

 library(shiny)
 library(shinydashboard)
 library(DT)


  # Define UI for application that draws a histogram
  ui <- fluidPage(

  dashboardPage(
    dashboardHeader( title = "Simple Test"),

    dashboardSidebar(),      
    dashboardBody(          
    fluidRow(

           box(title = h3("S.01.01.02", style = "display:inline; font-weight:bold"),

             selectInput("s010102i", label = NULL, 
                         choices = list("Not good" = 1, "O.K" = 2, "Good" = 3), 
                         selected = 1) ,width = 12, background = "blue", status = renderUI("s010102o"))
                                                                              # I want a text or a variable here
                                                                              # Logically "danger", warning or success
           # If Not good is selected, i wan that the status (the color) go to red (danger)
    ))))



  # Define server logic required to draw a histogram
  server <- function(input, output) {

    statut = c("danger","warning","success")


    output$s010102o <- reactive({  
      valueStatut = input$s010102i # Give 1 2 or 3
      s010102o =  statut[valueStatut] # give the value of the statut if "danger" the box changes to red 

    })
  }

  # Run the application 
  shinyApp(ui = ui, server = server)

Answer 1

解决方案是使用 renderUI 在服务器中创建整个盒子，然后使用 uiOutput 在 UI 中呈现它。你可以这样做：

library(shiny)
library(shinydashboard)
library(DT)


# Define UI for application that draws a histogram
ui <- fluidPage(

  dashboardPage(
    dashboardHeader( title = "Simple Test"),

    dashboardSidebar(),      
    dashboardBody(          
      fluidRow(
        uiOutput("s010102o")
      ))))



# Define server logic required to draw a histogram
server <- function(input, output) {

  statut = c("danger","warning","success")

  output$s010102o <- renderUI({
    box(title = h3("S.01.01.02", style = "display:inline; font-weight:bold"),

        selectInput("s010102i", label = NULL, 
                    choices = list("Not good" = "danger", "O.K" = "info", "Good" = "success"), 
                    selected = 1) ,width = 12, background = "blue")})

  observeEvent(input$s010102i,{
    output$s010102o <- renderUI({
      box(title = h3("S.01.01.02", style = "display:inline; font-weight:bold"),

          selectInput("s010102i", label = NULL,
                      choices = list("Not good" = "danger", "O.K" = "info", "Good" = "success"),
                      selected = input$s010102i) ,width = 12, background = "blue",status = input$s010102i)
    })


  })

}

# Run the application 
shinyApp(ui = ui, server = server)

但在更新输入框时要小心。