Search code examples
rshinybslib

How to keep a consistent bslib::value_box height in a shiny app when one value_box should change background color dynamically?


I would like to display several value boxes in a Shiny application. One of the valueboxes should change colors based on the selected value that will be displayed. In the example below, the color will change if input the value is above a certain threshold (4 in this case).

My questions are:

  • How can I ensure that the valueboxes that are run on the server side will be the same size as the ones that are created only in the UI?
  • Do I actually need to use shiny::uiOutput to achieve the dynamic change of color? Or is there a better way to update bslib::value_box without re-rendering the entire box?

My attempt below:

library(shiny)
library(bslib)
ui <- page_fixed(
  shiny::selectInput(
    inputId = "selected.events", 
    label = "Select events",
    choices = c(1:10)
  ),
  bslib::layout_columns(
    row_heights = 1, # fixing row_heights seems to only control 
                     # the value_box on the UI side, not the one 
                     # on the server side
    bslib::value_box(
      title = "Box with static info",
      value = ".."
      ),
  shiny::uiOutput("events")
)
)

server <- function(input, output) {
  output$events <- renderUI({
    bslib::value_box(
    title = "Events",
    value = input$selected.events,
    theme_color = if(as.numeric(input$selected.events) > 4) "warning" else "primary"
  )
  })
}

shinyApp(ui, server)

The output is like this, with valueboxes of unequal height: value boxes with unequal height

I am using bslib v0.5.0 and Shiny v1.7.4.1


Solution

  • For consistent height between HTML elements, I like to work with display:flex properties. Then I only added a height:100% property to the .bslib-card class to make it work.

    In order to change the color of the box without having to specify it in the renderUI, you can play with shinyjs::runjs. See the example below :

    library(shiny)
    library(bslib)
    library(shinyjs)
    
    ui <- page_fixed(
      shinyjs::useShinyjs(),
      tags$head(tags$style(HTML(".bslib-card {height:100%;}"))),
      shiny::selectInput(
        inputId = "selected.events", 
        label = "Select events",
        choices = c(1:10)
      ),
      div(style = "display:flex;flex-direction: column;",
      bslib::layout_columns(
        row_heights = 1, 
        bslib::value_box(
          title = "Box with static info",
          value = ".."
        ),
        shiny::uiOutput("events")
      )
      )
    )
    
    server <- function(input, output) {
      output$events <- renderUI({
        bslib::value_box(
          title = "Events",
          value = input$selected.events
          #theme_color = if(as.numeric(input$selected.events) > 4) "warning" else "primary"
        )
      })
      
      
      observeEvent(input$selected.events, {
        if(as.numeric(input$selected.events) > 4) {
          delay(10, shinyjs::runjs("$('#events div:eq(1)').removeClass('bg-primary');"))
          delay(10, shinyjs::runjs("$('#events div:eq(1)').addClass('bg-warning');"))
        } else {
          delay(10, shinyjs::runjs("$('#events div:eq(1)').removeClass('bg-warning');"))
          delay(10, shinyjs::runjs("$('#events div:eq(1)').addClass('bg-primary');"))
        }
      })
    }
    
    shinyApp(ui, server)