1

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

Leon Samson
  • 405
  • 3
  • 12

1 Answers1

0

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)
Bambs
  • 545
  • 4
  • 14
  • Thanks for the answer. I have never worked with the shinyjs package, I will give it a try. For my understanding: why are the additional delay functions needed? – Leon Samson Aug 01 '23 at 16:49
  • Here the delay function allows to wait that the #events element is actually rendered in the app and that its first div child exists. – Bambs Aug 02 '23 at 19:15
  • It took me some time to research and apply this to my large app, mostly because my CSS knowledge was non-existent, but it works, thanks. Still if someone finds a native solution within the bslib library, I am happy to hear it. – Leon Samson Aug 08 '23 at 19:11