动态更新值框主题（shiny、bslib）

Question

我正在尝试动态更新

value_box()

的主题。然而，主题论点尤其给我带来了问题。下面的应用程序无法运行，但如果您注释掉

theme = textOutput("box_status"),

行，则该应用程序可以运行。有什么想法可以让主题参数动态更新而不会出现错误吗？

错误信息是

警告：value_box_theme 中的错误：

theme

必须是单个值，例如“主要”、“危险”、“紫色”等

这让我相信

value_box()

正在尝试在计算

box_status()

反应之前渲染。我尝试将整个值框包装在

renderUI

函数中，但这也不起作用（同样的问题）。

library(shiny)
library(bslib)

# Define UI for application
ui <- fluidPage(
  # Use Minty Theme
  theme = bs_theme(bootswatch = "minty"),
  
  # Input box
  selectInput("status", "Status", 
              choices = c("danger", "success")),
  
  # Value box
  value_box(title = textOutput("box_status"),
            theme = textOutput("box_status"),
            value = textOutput("box_status"))
  )

# Define server logic
server <- function(input, output) {
  
  # Create a reactive expression
  box_status <- reactive({
    input$status
  })
  
  # Incorporate reactive into output
  output$box_status <- renderText({
    box_status()
  })
}

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

Answer 1

您将整个

value_box()

包裹在

renderUI

中的想法很好，这应该可行：

library(shiny)
library(bslib)

# Define UI for application
ui <- page_fluid(
  # Use Minty Theme
  theme = bs_theme(bootswatch = "minty"),
  
  # Input box
  selectInput("status", "Status", 
              choices = c("danger", "success")),
  
  # Value box
  uiOutput("box_status")
)

# Define server logic
server <- function(input, output) {
  
  # Create a reactive expression
  box_status <- reactive({
    input$status
  })
  
  # Incorporate reactive into output
  output$box_status <- renderUI({
    value_box(
      title = box_status(),
      value = box_status(),
      theme = box_status()
    )
  })
}

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