22

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)
micstr
  • 5,080
  • 8
  • 48
  • 76
czqiu
  • 291
  • 1
  • 3
  • 7

3 Answers3

45

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)

enter image description here

Pork Chop
  • 28,528
  • 5
  • 63
  • 77
  • How to accept it? I clicked the up arrow. Does that mean I have accepted it? Thanks again for your help! – czqiu May 01 '16 at 23:55
  • @czqiu See here: [How does accepting an answer work?](https://meta.stackexchange.com/questions/5234/how-does-accepting-an-answer-work) – zx8754 Nov 06 '17 at 08:46
  • Using this, and happy that it works. But it's a joy when you have 50 sliders in your app to style..... – Mark Nov 06 '18 at 15:33
  • 1
    I love this solution however your code does't seems to change the blue border color. Is it possible ? – Gowachin Jan 17 '21 at 23:29
6

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 }'
                    ))
               )
Julian
  • 741
  • 8
  • 19
camnesia
  • 2,143
  • 20
  • 26
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)
Julian
  • 741
  • 8
  • 19