rshinyslider

R Shiny Suppress slider handle for sliderInput until click


I am trying to make a simple visual analogue scale inside a Shiny App. These types of scales are simple sliders that dont give any information to the user in order to not bias responses (no ticks, no labels). I managed to get the desired results except one: making the handle of the slider hidden until the slider is clicked by the user. I know I can hide the handle by using .irs-slider {display: none;} but what I want is for it to appear when the user clicks on the slider and for it to appear in the spot (at the value) clicked by the user.

This is what I have written till now:

library(shiny)

server <-function(input, output) {

  output$value <- renderPrint({ input$slider1 })

}


ui <- fixedPage(
  tags$style(type = "text/css", "
      .irs-bar {display: none;}
      .slidecontainer { width: 100%; }
      .irs-bar-edge {display: none;}
      .irs-grid-pol {display: none;}
      .irs-slider {width: 10px; height: 20px; top: 20px;}
      .irs-from, .irs-to, .irs-min, .irs-max { visibility: hidden !important;   }
      .irs-single {visibility: hidden !important; }
  "),

  titlePanel("Title"),
  br(),
  h4("Please respond"),

  fluidRow(
    column(12, align="center",

       sliderInput(
         inputId = "slider1", 
         label = h3("Slider"), 
         min=0, max=100, value=50,
         ticks=FALSE,
         width="100%"
       )
    )
  ),

  br(),

  fluidRow(
  column(4, verbatimTextOutput("value"))
  )

)

shinyApp(ui, server)

Solution

  • Here is a solution using the shinyjs package, which provides functionality to add javascript code to your app.

    I have added .irs-slider.single { opacity: 0;} to the css block to make the handle transparent when the page loads. The js code is in runjs in the server section, which uses jquery to change the handle opacity to 1 when the .irs div is clicked; you can play around with this to be a more specific page element if you want, but .irs-line didn't seem to work for me.

    You also need to add useShinyjs() somewhere in the UI.

    library(shiny); library(shinyjs)
    
    server <-function(input, output) {
    
      output$value <- renderPrint({ input$slider1 })
      runjs("$( '.irs').click(function(){$('.irs-slider.single').css('opacity', 1)})")
    }
    
    
    ui <- fixedPage(
      tags$style(type = "text/css", "
                 .irs-bar {display: none;}
                 .irs-slider.single { opacity: 0;}
                 .slidecontainer { width: 100%; }
                 .irs-bar-edge {display: none;}
                 .irs-grid-pol {display: none;}
                 .irs-slider {width: 10px; height: 20px; top: 20px;}
                 .irs-from, .irs-to, .irs-min, .irs-max { visibility: hidden !important;   }
                 .irs-single {visibility: hidden !important; }
                 "),
      useShinyjs(),
    
    
    
      titlePanel("Title"),
      br(),
      h4("Please respond"),
    
      fluidRow(
        column(12, align="center",
    
           sliderInput(
             inputId = "slider1", 
             label = h3("Slider"), 
             min=0, max=100, value=50,
             ticks=FALSE,
             width="100%"
           )
        )
      ),
    
      br(),
    
      fluidRow(
      column(4, verbatimTextOutput("value"))
      )
    
    )
    
    shinyApp(ui, server)