How to color sliderbar (sliderInput)?

Question

I tried to make different color for a few sliderInput bar in R shiny. It requires css etc. I looked online and can only find how to make one sliderInput. How can I make create several different color to different bars?

Here are my testing code. It will show all bar in same style:

 ui <- fluidPage(
   tags$style(type = "text/css", "
              .irs-bar {width: 100%; height: 25px; background: black; border-top: 1px solid black; border-bottom: 1px solid black;}
              .irs-bar-edge {background: black; border: 1px solid black; height: 25px; border-radius: 0px; width: 20px;}
              .irs-line {border: 1px solid black; height: 25px; border-radius: 0px;}
              .irs-grid-text {font-family: 'arial'; color: white; bottom: 17px; z-index: 1;}
              .irs-grid-pol {display: none;}
              .irs-max {font-family: 'arial'; color: black;}
              .irs-min {font-family: 'arial'; color: black;}
              .irs-single {color:black; background:#6666ff;}
              .irs-slider {width: 30px; height: 30px; top: 22px;}

             .irs-bar1 {width: 50%; height: 25px; background: red; border-top: 1px solid black; border-bottom: 1px solid black;}
              .irs-bar-edge1 {background: black; border: 1px solid red; height: 25px; border-radius: 0px; width: 20px;}
              .irs-line1 {border: 1px solid red; height: 25px; border-radius: 0px;}
              .irs-grid-text1 {font-family: 'arial'; color: white; bottom: 17px; z-index: 1;}
              .irs-grid-pol1 {display: none;}
              .irs-max1 {font-family: 'arial'; color: red;}
              .irs-min1 {font-family: 'arial'; color: red;}
              .irs-single1 {color:black; background:#6666ff;}
              .irs-slider1 {width: 30px; height: 30px; top: 22px;}
              
             "),

  uiOutput("testSlider")
  )

server <- function(input, output, session){
  output$testSlider <- renderUI({
    fluidRow(
      column(width=3, 
             box(
               title = "Preferences", width = NULL, status = "primary",
               sliderInput(inputId="test", label=NULL, min=1, max=10, value=5, step = 1, width='100%'),
               sliderInput(inputId="test2", label=NULL, min=1, max=10, value=5, step = 1, width='50%')
             )     
      ))
  })
}

shinyApp(ui = ui, server=server)

Answer 1

Below is a sample code of how you can modify style of the sliders. You can add your own logic to it.

rm(list = ls())
library(shiny)
ui <- fluidPage(
  # All your styles will go here
  tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: purple}")),
  tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: red}")),
  tags$style(HTML(".js-irs-2 .irs-single, .js-irs-2 .irs-bar-edge, .js-irs-2 .irs-bar {background: green}")),

  sliderInput("slider1", "Slider 1",min = 0.1, max = 1, value = 0.4, step = 0.05),
  sliderInput("slider2", "Slider 2",min = 0.1, max = 1, value = 0.4, step = 0.05),                               
  sliderInput("slider3", "Slider 3",min = 100, max = 20000, value = 5000, step= 200)

)
server <- function(input, output, session){}
shinyApp(ui = ui, server=server)

Answer 2

The previous answer unfortunately only changed the bar colour for me and not the number tags above. This did the trick for the rest of them. (Replace the hex colour codes with what ever colour you like).

/* changes the colour of the bars */ 
tags$head(tags$style(HTML('.js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {
                                                  background: #000069;
                                                  border-top: 1px solid #000039 ;
                                                  border-bottom: 1px solid #000039 ;}

                            /* changes the colour of the number tags */
                           .irs-from, .irs-to, .irs-single { background: #000069 }'
                    ))
               )

Answer 3

The above solutions will not work when sliders are generated dynamically and reused, since it relies on the counting of the class of the container (".js-irs-0"). When reinitializing the slider, the count will increase. Compare sliders 1 vs 2 and 3 in the example below.

If CSS would allow parent-selectors, one could use the id of the input to select the elements needed (id does not change). Since this is not posssible, another solution is needed. Fortunately the label has a for=id-attribute, which can be used to select the following sibblings - the span-elements containing bars etc. I have also highlighted the label of slider 2 for better understanding. See also this overview of CSS-selectors.

library(shiny)
library(shinyjs)

`%||%` <- function(a, b) {
  if (!is.null(a)) a else b
}

NUM_PAGES <- 3

ui<- fluidPage(
  useShinyjs(), 
  tags$head(tags$style(HTML('.js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {
                                                  background: purple;
                            }
                            '
  ))
  ),
  tags$head(tags$style(HTML(' [for=sl2]+span>.irs>.irs-single, [for=sl2]+span>.irs-bar-edge, [for=sl2]+span>.irs-bar {
                                                  background: green;} 

                            [for=sl2]{color:red;}
                            [for=sl3]+span>.irs>.irs-single, [for=sl3]+span>.irs-bar-edge, [for=sl3]+span>.irs-bar {
                                                  background: grey;} 

                            '
  ))
  ),
  uiOutput("ui"),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
  )

server<- function(input, output, session) {
  rv <- reactiveValues(page = 1)

  uilist <- reactive(list(
    sliderInput("sl1","Dies ist slider 1", 1,101,input$sl1%||%11),
    sliderInput("sl2","Dies ist slider 2", 2,102,input$sl2%||%22),
    sliderInput("sl3","Dies ist slider 3", 3,103,input$sl3%||%33)
  ))

  observeEvent(rv$page,{
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES+1)

    if(rv$page <= NUM_PAGES){
      #Einzelne Slider
      toggleState(id = "prevBtn", condition = rv$page > 1)
      output$ui<- renderUI(uilist()[[rv$page]])  
    }else{
      #Am Ende Gesamtliste
      output$ui<- renderUI(uilist())
    }


  })

  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }

  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, navPage(1))
}

shinyApp(ui, server)