apply a class to textOutput conditionally

[Magnetar]

I'm building an app, and on one of the cards I've made I would like the text to be red if the number falls below zero.

This is reactive text and I was referencing like this

# ---- card-header 
cardHeader <- function(title) {
  h5(
    title,
    style = "color: #344a5e;"
  )
}

# ---- card 
Card <- function(title, content, size = "", style = "") {
  div(class = glue("card ms-depth-4 ms-fontSize-16 ms-fontWeight-bold ms-sm-fontSize-16 ms-xl-fontSize-16"),
      style = style,
      Stack(
        tokens = list(childrenGap = -5),
        Text(variant = "xLarge", title, block = TRUE),
        content
      ))
}


card3 <- Card(
  tags$div(
    gridPanel(
      rows = "repeat(2 0.2fr)",
      gridPanel(
        rows = "1fr 0.10fr",
        gap = "0px",
        
        div(cardHeader("Total"))
      )
    )
  ),
  div(class = 'figure',
      textOutput("indig")
  )
)

tried the following but error in dots_list(...)

card4 <- Card(
  tags$div(
    gridPanel(
      rows = "repeat(2 0.2fr)",
      gridPanel(
        rows = "1fr 0.10fr",
        gap = "0px",
        
        div(cardHeader("Total"))
      )
    )
  ),
 
  div(
    if(textOutput("total_gen") > 0){
      class = 'figure'
    }
    else {
      class = 'figure_2'
    }
  )
)

How can I apply a conditional onto style here?

[keithn]

As a rule, code in the UI file or page only runs once to build the HTML interface when the app starts, so you won't be able to run

    if(textOutput("total_gen") > 0){
      class = 'figure'
    }
    else {
      class = 'figure_2'
    }

if it's in the UI because when textOutput() changes, it's too late for the UI code to run again.

You have two choices for a workaround.

1: Render the HTML code in the server using renderUI().

output$my_card <- renderUI({
  card_class <- ifelse(number >= 0, "figure", "figure_2")
  card(
    "foo",
    class = card_class
  )
})

and then tell the UI where that bit of rendered HTML goes by including uiOutput("my_card") in the relevant part of the UI code.

[opinion] I personally avoid this for small things like this scenario because it's marginally heavier on the server and fractionally slower to render. A more performant option for small tasks like this is triggering some client-side Javascript to run. The easiest way into this if you aren't familiar with JavaScript is...

2: shinyJS

I've made a working app that uses ShinyJS to trigger the change of what class attributes are on an element. As a shortcut, I'm using the card() from the bslib package, but the concept can be transcribed to your own implementation of card. Just note that:

• I'm using Bootstrap version 5, while you may be on Bootstrap version 3, so the class names may be different.
• You also need to make sure the div containing the class you want to edit has a unique id attribute too (and it also can't conflict with an id value used on any shiny input or output). Just add a div(..., id = "my_id_name_here") argument.

library(shiny)
library(shinyjs)
library(bslib)

ui <- fluidPage(
  theme = bs_theme(),
  titlePanel("Colourful cards"),
  useShinyjs(),  # Include shinyjs
  sidebarLayout(
    sidebarPanel(
      actionButton("new_number", "Generate new number")
    ),
    mainPanel(
      bslib::card(
        card_header("Your lucky number is..."),
        card_body(textOutput("chosen_number"), class = "text-white"),
        card_footer("Better luck next time!"),
        class = "text-black bg-primary",
        id = "target-card" # Give each card a unique ID so it can be found.
      )
    )
  )
)

server <- function(input, output) {
  output$chosen_number <- renderText({
    number <- sample(-10:10, 1)
    # Trigger client-side updates of the classes in your card.
    if (number < 0) {
      removeCssClass("target-card", "bg-success")
      addCssClass("target-card", "bg-danger")
    } else {
      removeCssClass("target-card", "bg-danger")
      addCssClass("target-card", "bg-success")
    }
    return(number)
  }) |>
    bindEvent(input$new_number)
}

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

[Magnetar]

Wow Keith this is fantastic! Thank you for the detailed explanation!