在 R Shiny 中使用 renderUI 时如何在多个滑块上使用 setSliderColor 更改滑块颜色

Question

我有多个滑块，它们对我想更改颜色的其他数据有反应。我试图避免长时间的 CSS 代码，所以我想使用 shinyWidget 的 setSliderColor() 函数是可能的。这个在我只有一个滑块时有效，但现在我有两个滑块时，它就不起作用了。这是一个可重现的例子：

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({
            
            if(length(data()) > 0) {
                
                fluidPage(setSliderColor("#CA001B", sliderId = 1),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)))}
            
        })
        
        output$num_slider2 <- renderUI({
            
            if(length(data()) > 0) {
                #This one won't change color
                fluidPage(setSliderColor("#CA001B", sliderId = 2),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 100,
                                      max = 10000,
                                      value = c(100, 10000)))}
            
        })
    
}

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

我试过将 sliderId 都改为 1，甚至从 -100:100 开始，但我只能让它改变一个滑块。奇怪的是，在我的真实仪表板中，它只更改了最后一个，但没有更改较早的滑块，但在这个仪表板中，它只更改了第一个。我想知道它是否可以按照我编码的顺序执行？如有任何帮助，我们将不胜感激！

Answer 1

我通过将两个颜色开关合并为一个 setSliderColor() 得到了你的代码运行。像这样，在不同的条件下改变并不是那么舒服。

library(shiny)
library(shinyWidgets)
library(DT) # added DT lib

ui <- fluidPage(
  
  
  sidebarLayout(
    sidebarPanel(
      textInput(inputId = "greeting",
                label = "Say hi!",value = "hi!"), #to not always click
      actionButton(inputId = "submit", 
                   label = "Submit"),
      
      uiOutput("num_slider1"),
      uiOutput("num_slider2"),
      
      
    ),
    mainPanel(DT::DTOutput("table"))
  ))

server <- function(input, output) {
  
  data <- reactive({
    req(input$submit |  0==0) #to not always click
    if(input$greeting == "hi!") {
      tibble(name = c("Justin", "Corey", "Sibley"),
             grade = c(50, 100, 100))}
  })
  
  output$table <- renderDT({
    datatable(data())
  })
  
  
  output$num_slider1 <- renderUI({
    
    if(length(data()) > 0) {
      
      fluidPage(setSliderColor(c("#CA001B","green"), sliderId = c(1,2)), #put vectors here to change the colors
                sliderInput(inputId = "num_slider1",
                            label = "Filter by Number",
                            min = 1,
                            max = 10,
                            value = c(1, 10)))}
    
  })
  
  output$num_slider2 <- renderUI({
    
    if(length(data()) > 0) {
      #This one won't change color
      #fluidPage(setSliderColor("yellow", sliderId = 2),
                sliderInput(inputId = "num_slider2",
                            label = "Filter by Number",
                            min = 100,
                            max = 10000,
                            value = c(100, 10000)))}
    
  })
  
}

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

Answer 2

我调整了代码，使其在输出中可以有不同的持久颜色。请注意不属于 renderUI 的 sliderInput 也如何更改颜色。我还删除了 renderUI 中的 FluidPage 调用，因为它影响了输入的大小并且并不是真正必要的（因为 setSliderColor returns tags$head() 对象）。

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor('orange', sliderId = c(1)),
    
    sidebarLayout(
        
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),
            
            uiOutput("num_slider"),
            sliderInput(inputId = "num_filter1",
                        label = "Now it works!",
                        min = 1,
                        max = 10,
                        value = c(1, 10))
            
        ),
        mainPanel()
    ))

server <- function(input, output) {
    
    i <- reactiveValues()
    i$color <- 1
    i$color_name <- 'violet'
    
    
    observeEvent(input$submit, {
        
        i$color <- c(i$color, i$color[[length(i$color)]] + 1, i$color[[length(i$color)]] + 2)
        i$color_name <- c(i$color_name, 'green', 'red')
        
        #left for demonstration purposes
        print(i$color)
        print(i$color_name)
        
        shiny::req(input$greeting)
        shiny::req(input$submit)
        
        
        output$num_slider <- renderUI({
            
            if(input$greeting == "hi!") {
                
                tagList(setSliderColor(i$color_name, sliderId = i$color),
                          sliderInput(inputId = "num_filter1",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)),
            
               
                      sliderInput(inputId = "num_filter2",
                                  label = "Filter by Number",
                                  min = 1,
                                  max = 10,
                                  value = c(1, 10)))}
            
            
        }) }) 
    
}

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

在 R Shiny 中使用 renderUI 时如何在多个滑块上使用 setSliderColor 更改滑块颜色

How to change slider bar color using setSliderColor on multiple sliders when using renderUI in R Shiny

r

shiny

reactive

shinywidgets

renderui