Search code examples
rshinyshinywidgets

Change color of slider using updateSliderTextInput


I am trying to change the color of the slide when updating its values. I have tried different ways without success. The following code does not run, but replicates what I am trying to do:

if (interactive()) {
  library("shiny")
  library("shinyWidgets")
  
  ui <- fluidPage(
    br(),
    sliderTextInput(
      inputId = "mySlider",
      label = "Pick a month :",
      choices = month.abb,
      selected = "Jan"
    ),
    verbatimTextOutput(outputId = "res"),
    radioButtons(
      inputId = "up",
      label = "Update choices:",
      choices = c("Abbreviations", "Full names")
    )
  )
  
  server <- function(input, output, session) {
    output$res <- renderPrint(str(input$mySlider))
    
    observeEvent(input$up, {
      choices <- switch(
        input$up,
        "Abbreviations" = month.abb,
        "Full names" = month.name
      )
      updateSliderTextInput(
        session = session,
        inputId = "mySlider",
        choices = choices,
        color = "red" # This is the line I need to add
      )
    }, ignoreInit = TRUE)
  }
  
  shinyApp(ui = ui, server = server)
}

Maybe has someone the answer to this?


Solution

  • I was able to give this some more thought and figured out a way to update the slider color based on an input. shinyWidgets::setSliderColor essentially just injects CSS to overwrite all the classes associated with the sliderInputs. So it needs to be included in the UI instead of the server. (Took a min to realize that).

    I set up a blank uiOutput which is then updated by observing input$up with the new or default color.

    Demo

    enter image description here

    ui <- fluidPage(
      br(),
      mainPanel(class = "temp",
        uiOutput('s_color'), # uiOuput
        sliderTextInput(
          inputId = "mySlider",
          label = "Pick a month :",
          choices = month.abb,
          selected = "Jan"
        ),
        verbatimTextOutput(outputId = "res"),
        radioButtons(
          inputId = "up",
          label = "Update choices:",
          choices = c("Abbreviations", "Full names")
        )
      )
    )
    
    server <- function(input, output, session) {
      output$res <- renderPrint(str(input$mySlider))
      
      # output$s_color = renderUI({})
      observeEvent(input$up, {
        choices <- switch(
          input$up,
          "Abbreviations" = month.abb,
          "Full names" = month.name
        )
        updateSliderTextInput(
          session = session,
          inputId = "mySlider",
          choices = choices
        )
        output$s_color = renderUI({ # add color 
          if (input$up == "Full names") {
            setSliderColor(c("Red"), c(1))
          } else {
            setSliderColor(c("#428bca"), c(1))
          }
        })
      }, ignoreInit = TRUE)
    }
    
    shinyApp(ui = ui, server = server)