Dynamically change the class of a bslib value box in Shiny

Question

I use a value_box from the bslib-package to display values in a Shiny dashboard. The shown value depends on user input via various selectors which requires me to dynamically update the value box. This works well for the title and value using the approach outlined here.

However, I also want to change the class of the value box depending on the value: E.g. if the value is below a certain threshold, show a red value box, if it's high show a green one.

Here's an MWE to illustrate my approach:

library(tidyverse)
library(shiny)
library(bslib)

test_df <- tibble(id = 1:2, 
                  title = c("low value","high value"), 
                  value = c(30, 80))

ui <- page_fixed(
  selectInput("select_id", "Selected ID", choices = 1:2, selected = 1),
  value_box(title = textOutput("vbox_title"),
            value = textOutput("vbox_value"),
            class = textOutput("vbox_class")
  ),
)

server <- function(input, output, session) {

  subset_df <- reactive({
    test_df %>%
      filter(id == input$select_id)
  })
  
  output$vbox_title <- renderText({
    subset_df() %>%
      pull(title)
  })

  output$vbox_value <- renderText({
    subset_df() %>%
      pull(value)
  })
  
  output$vbox_class <- renderText({
    value <- subset_df() %>%
      pull(value)
  
    ifelse(value > 50, "bg-success", "bg-warning")
  })
}

shinyApp(ui, server)

Unfortunately, the text output for the class gets processed as div list(id = "vbox_class", class = "shiny-text-output") list() and I cannot figure out how to just pass the raw string to the class argument. I have already tried using verbatimTextOutput() and transforming the output with as.character(), both unsuccessfully.

I realize it would be easier to just create the value boxes inside the server function with the appropriate class. But in my real application I actually need the value box to persist since it contains other elements that are not updated.

Is there a way to remove the container from textOutput() to make this work? Or does changing the class require the use of style tags?

server-side rendering using `renderUI`would be the easiest. But you stated it wouldn't work on the real world app. Are you sure? — user12256545, Aug 15 '23 at 12:39
Yes, the `renderUI`-path was my original approach that I had to give up because I include an `actionLink` in the box to trigger updates. Its value is being reset by `renderUI` so that I cannot keep track of it. Your shinyjs-solution is the way to go in my case. — Dave, Aug 15 '23 at 14:11

score 1 · Accepted Answer · answered Aug 15 '23 at 13:41

One easy solution to dynamically change the css class would be to use shinyjs. To use this, you would need to:

call useShinyjs in the UI
add an id to your card
get a reactive of the value : ie value
update the css in the server

It would look something like that:

library(shinyjs)

test_df <- tibble(id = 1:2, 
                  title = c("low value","high value"), 
                  value = c(30, 80))

ui <- page_fixed(
  # invoce Shinyjs:
  useShinyjs(), 
  selectInput("select_id", "Selected ID", choices = 1:2, selected = 1),
  value_box(id = "card1", # set an ID
            title = textOutput("vbox_title"),
            value = textOutput("vbox_value"),
            class = NULL
  )
)

server <- function(input, output, session) {
  
  subset_df <- reactive({
    test_df %>%
      filter(id == input$select_id)
  })
  # Pull reactive here:
  value <- reactive({subset_df() %>% pull(value)})
  
  output$vbox_value <- renderText({
    value()
  })
  
  output$vbox_title <- renderText({
    subset_df() %>%
      pull(title)
  })

  #update CSS class
  observeEvent(value(),{
    if (value() > 50) {
      removeCssClass(id = "card1", class = "bg-warning")
      addCssClass(id = "card1",class = "bg-success")
    }else if(value() <= 50){
      removeCssClass(id = "card1", class = "bg-success")
      addCssClass(id = "card1",class = "bg-warning")
    }
  })

}
shinyApp(ui, server)

Another easy solution to the problem would be using renderUIand rendering the whole thing on the server. This would look somthing like that:

ui <- page_fixed(
  selectInput("select_id", "Selected ID", choices = 1:2, selected = 1),
  uiOutput("vbox")
)

server <- function(input, output, session) {
  
  subset_df <- reactive({
    test_df %>%
      filter(id == input$select_id)
  })
  output$vbox <- renderUI({
    value_box(
      title = subset_df()$title,
      value = subset_df()$value,
      class = ifelse(subset_df()$value > 50, "bg-success", "bg-warning")
    )
  })

}

shinyApp(ui, server)

Dynamically change the class of a bslib value box in Shiny

1 Answers1