根據來自 shiny 應用程序中動態框（）內的小部件的值為動態框（）着色

Question

在下面的shiny應用程序中，我根據包含在box()中的sliderInput()的值為框着色。 問題是如果框沒有值，它最初不會顯示。

## app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    tags$head(
      tags$style(HTML("
                      
                      #mybox2Red{border-top-style: none; border-left-color: red; border-left-style: solid;}
                      #mybox2Green{border-top-style: none; border-left-color: green; border-left-style: solid;}
                      "))
      ),
    
    uiOutput("box2")
      )
      )


server <- function(input, output) { 
  
  
  output$box2<-renderUI({
    req(input$vr)
    if(input$vr<=5){
      tags$style(
        type = 'text/css',
        "#mybox2Red{border-top-style: none; border-left-color: red; border-left-style: solid;}"
      )
      box(
        id="mybox2Red",
        title = "title", 
        closable = TRUE, 
        width = 10,
        status = "danger", 
        solidHeader = F, 
        collapsible = TRUE,
        collapsed = T,
        sliderInput("vr","Set value range",min = 0,max=10,value =  5)
      )
    }
    else{
      tags$style(
        type = 'text/css',
        "#mybox2Green{border-top-style: none; border-left-color: green; border-left-style: solid;}"
      )
      box(
        id="mybox2Green",
        title = "title", 
        closable = TRUE, 
        width = 10,
        status = "danger", 
        solidHeader = F, 
        collapsible = TRUE,
        collapsed = T,
        sliderInput("vr","Set value range",min = 0,max=10,value =  5)
        
      )
    }
  })
}

shinyApp(ui, server)

Answer 1

如果您將值中繼到可以輕松完成的無功值。 現在您可以在ValueRange之外初始化renderUI並以這種方式規避問題。

我稍微更改了renderUI 。 以您的方式使用if需要維護 dame 代碼兩次。 除非你打算在 2 個框狀態中添加更多差異，否則將來會容易得多（也更容易閱讀）。 現在條件僅更改框 ID。 但是 - 當然 - 如果它對你的想法沒有意義，你可以忽略它。

請注意，由於collapsed = T ，slider 的每次更新都會折疊框。

## app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    tags$head(
      tags$style(HTML("
      #mybox2Red{border-top-style: none; border-left-color: red; border-left-style: solid;}
      #mybox2Green{border-top-style: none; border-left-color: green; border-left-style: solid;}
      "))
    ),
    uiOutput("box2")
  )
)


server <- function(input, output) {
  ValueRange <- reactiveVal(5)
  
  observeEvent(input$vr, ValueRange(input$vr))
  
  output$box2 <- renderUI({
    req(ValueRange)

    box(
        id=ifelse(input$vr<=5, "mybox2Red", "mybox2Green"),
        title = "title", 
        closable = TRUE, 
        width = 10,
        status = "danger", 
        solidHeader = F, 
        collapsible = TRUE,
        collapsed = T,
        sliderInput("vr","Set value range", min = 0, max=10, value =  ValueRange())
      )
  })
}

shinyApp(ui, server)