rshinybslib

Dynamically update value box theme (shiny, bslib)


I'm trying to update the theme of a value_box() dynamically. However, the theme argument in particular is giving me issues. The app below does not work, but if you comment out the theme = textOutput("box_status"), line, then the app works. Any ideas how I can get it so the theme argument is dynamically updated without error?

The error message is

Warning: Error in value_box_theme: theme must be a single value, e.g. "primary", "danger", "purple", etc.

This leads me to belive the value_box() is trying to render before the box_status() reactive is computed. I tried wrapping the entire valuebox inside a renderUI function, but that didn't work either (same issue).

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)

Solution

  • Your idea to wrap the entire value_box() inside a renderUI is good, this should work:

    enter image description here

    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)