Change sliderbar color with setSliderColor within reactive output

Question

I'm building a shiny app that has a reactive slider that I want the bar color to be red. I'm trying to use the setSliderColor() function from the shinyWidgets package, but it's not working. My assumption is that it isn't picking up on the sliderId because it isn't:

            
library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor(c("green"), sliderId = c(1)),

    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),

            uiOutput("num_slider"),

        ),
    mainPanel()
))

server <- function(input, output) {
    
    output$num_slider <- renderUI({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            
        sliderInput(inputId = "num_filter2",
                    label = "Filter by Number",
                    min = 1,
                    max = 10,
                    value = c(1, 10))
        } else {
            sliderInput(inputId = "num_filter2",
                        label = "Filter by Number",
                        min = 1,
                        max = 5,
                        value = c(1, 5))
        }
    })
    
}

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

But, here's the weird thing. If I put in a regular slider in the UI, it suddenly detects both--but then changes the color back to blue if I click submit twice:


library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor(c("green", "red"), sliderId = c(1, 2)),

    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) {
    
    output$num_slider <- renderUI({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            
        sliderInput(inputId = "num_filter2",
                    label = "Filter by Number",
                    min = 1,
                    max = 10,
                    value = c(1, 10))
        } else {
            sliderInput(inputId = "num_filter2",
                        label = "Filter by Number",
                        min = 1,
                        max = 5,
                        value = c(1, 5))
        }
    })
    
}

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

Any fix on how address this? I'm also open to other solutions if it avoids long bouts of HTML, like this answer.

score 2 · Accepted Answer · answered Jun 11 '21 at 05:42

The function is just not designed to work with renderUI(). The arguments need to be updated in each call.

a quick fix would be preallocate very large vectors that the user will never reach (like 1 million) or use reactiveValues() like this:

note: The sliders will turn green when "hi!" is passed as an input.

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    
    
    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 <- 'green'
    
    
    observeEvent(input$submit, {
        
        i$color <- c(i$color, i$color[[length(i$color)]] + 1)
        i$color_name <- c(i$color_name, 'green')
        
        #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!") {
                
                fluidPage(setSliderColor(i$color_name, sliderId = i$color),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)))}
            
        }) }) 
    
}

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

thank you for getting me on the right track! A simpler solution that builds off of yours is simply to wrap the fluidPage(setSliderColor() arguments around each slider input that are in the server by always setting the SliderId to 1. Then, you can easily customize the color for each slider individually without the i$color length, etc. — J.Sabree, Jun 11 '21 at 13:43
One limitation with this solution: I can only get it to work with one slider. In my code with 2 sliders, it only edits one of them and leaves the others as is — J.Sabree, Jun 11 '21 at 13:44
in case you have any ideas on why it's only works with one sliderinput, I opened up a new question on how to extend this solution to more than one: https://stackoverflow.com/questions/67938758/how-to-change-slider-bar-color-using-setslidercolor-on-multiple-sliders-when-usi — J.Sabree, Jun 11 '21 at 16:22

Change sliderbar color with setSliderColor within reactive output

1 Answers1

Linked