Css 在 Shiny 中动态更改 bslib 值框的类

动态更改css类的一个简单解决方案是使用shinyjs.要使用此功能，您需要:

1. 在用户界面中呼叫useShinyjs
2. 为您的卡添加ID
3. 获得价值的react 性:IE value
4. 更新服务器中的css

它看起来会是这样的:

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)

这个问题的另一个简单解决方案是使用renderUI并在服务器上呈现整个内容.这看起来应该是这样的:

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)