Change sliderbar color with setSliderColor within reactive output

user_9877445 0
Viewed 87

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.

shinywidgets reactive shiny reactive-programming r
1 Answers

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)
user_111687660
Related