让反应滑块在 R Shiny 中使用 css 样式标签，而不是忽略它们

Question

我有反应式滑块，我希望条形为红色。然而，这些条忽略了我的 CSS 样式标签，尽管当我输入参数时这些条确实缩短了（比较屏幕截图中的第一个和第二个条的长度）。如何让他们关注我的标签？

可重现的示例（注意：在最终答案中，我需要两个滑块都是红色的——我只将我的代码放在第一个以显示该部分仅通过缩短滑块的长度来响应）：

library(shiny)
library(shinyWidgets)



ui <- fluidPage(
    
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),
            
            uiOutput("num_slider"),
            uiOutput("num_slider2"),
            
            
        ),
        mainPanel(DT::DTOutput("table"))
    ))

server <- function(input, output) {
    
    
        data <- reactive({
            req(input$submit)
            if(input$greeting == "hi!") {
            tibble(name = c("Justin", "Corey", "Sibley"),
                       grade = c(50, 100, 100))}
        })
        
        output$table <- renderDT({
            datatable(data())
        })
        

        output$num_slider <- renderUI({
            fluidPage(
                #Slider ignores the style tags--just makes the bar shorter
                tags$style(
                    ".irs-bar {",
                    "  border-color: red;",
                    "  background-color: red;",
                    "}",
                    ".irs-bar-edge {",
                    "  border-color: red;",
                    "  background-color: red;",
                    "}"
                ),
            if(length(data()) > 0) {
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10))})
            
        })
        
        output$num_slider2 <- renderUI({
            
            if(length(data()) > 0) {
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 100,
                                      max = 10000,
                                      value = c(100, 10000))}
            
        })
    
}

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

注意不同的滑块长度。这不是问题，但它表明应用程序正在以某种方式响应我的代码，即使它没有使它们变红。我也尝试过使用 shinyWidget 的 setSliderColor()，但它只适用于一个滑块。

Answer 1

试试这个

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      textInput(inputId = "greeting",
                label = "Say hi!"),
      actionButton(inputId = "submit", 
                   label = "Submit"),
      
      uiOutput("num_slider") #,
      #uiOutput("num_slider2")
    ),
    mainPanel(DTOutput("table"))
  ))

server <- function(input, output) {
  
  data <- reactive({
    req(input$submit)
    if(input$greeting == "hi!") {
      tibble(name = c("Justin", "Corey", "Sibley"),
             grade = c(50, 100, 100))}
  })
  
  output$table <- renderDT({
    datatable(data())
  })
  
  
  output$num_slider <- renderUI({
    if (is.null(data())) return()
    tagList(
      tags$head(
        tags$style(type="text/css", ".slider1 label{ display: table-cell; text-align: left; vertical-align: middle; }
                                     .slider1 .irs-bar {border-color: red; background-color: orange;}
                                     .slider1 .irs-bar-edge { border-color: red; background-color: red;}")
      ),
      tags$div(id = "slider1", class="slider1", style="width:25vw;",
               sliderInput(inputId = "num_filter1",
                           label = "Filter by Number",
                           min = 1,
                           max = 10,
                           value = c(1, 10))
      ),
      tags$div(id = "slider2", class="slider1", style="width:25vw;",
               sliderInput(inputId = "num_filter2",
                           label = "Filter by Number",
                           min = 1,
                           max = 10,
                           value = c(1, 10))
      )
    )
  })
  
  # output$num_slider2 <- renderUI({
  #   
  #   if(length(data()) > 0) {
  #     sliderInput(inputId = "num_filter2",
  #                 label = "Filter by Number",
  #                 min = 100,
  #                 max = 10000,
  #                 value = c(100, 10000))}
  #   
  # })
  
}

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