CODEWITHSUNDEEP
javascriptrslidershiny
Bangyou
Bangyou

Reputation: 9816

Fixed multiple values in slideInput of shiny

I want to add a slideInput with multiple fixed values into my Shiny app to show the measurement date of my experiment. The interval of date is random.

This is my testing codes to want to show four dates in sliderInput. 

library(shiny)
values <- as.Date(c('2015-1-1, 2015-6-20', '2015-7-2', '2016-1-1'))
ui <- shinyUI(bootstrapPage(
    headerPanel("test"),
        sliderInput("foo", "Animation duration", 
                    min = as.Date('2015-1-1'),
                    max = as.Date('2016-1-1'), 
                    value = values,
                    timeFormat = '%d/%m/%Y')
    ))

server <- shinyServer(function(input, output, session) {
})

shinyApp(ui = ui, server = server)

The values also can be updated in the server.R.

selectInput could be another option, but I prefer to use sliderInput which do make sense for date.

I guess I have to manipulate some js scripts, but have no experience about it.

Thanks for any suggestions to implement it.

Upvotes: 1

Views: 538

Answers (2)

Ankit Daimary
Ankit Daimary

Reputation: 148

This can be easily done using sliderTextInput function in shiny. No need to add all this complex js function. Just a few lines of code will do the trick. Do the following :

  sliderTextInput("foo","Animation Duration" , 
                  choices = c('2015-1-1, 2015-6-20', '2015-7-2', '2016-1-1'), 
                  selected = c('2015-1-1, 2015-6-20', '2015-7-2', '2016-1-1'), 
                  animate = FALSE, grid = FALSE, 
                  hide_min_max = FALSE, from_fixed = FALSE,
                  to_fixed = FALSE, from_min = NULL, from_max = NULL, to_min = NULL,
                  to_max = NULL, force_edges = FALSE, width = NULL, pre = NULL,
                  post = NULL, dragRange = TRUE)

Upvotes: 0

SymbolixAU
SymbolixAU

Reputation: 26258

You can indeed do this with some javascript

library(shiny)

ui <- shinyUI(bootstrapPage(
  headerPanel("test"),

  sliderInput("bar", "bar dates", min=0, max=4, value=c(0,4)),

  tags$head(tags$script(
    HTML("
            $(function() {
              setTimeout(function(){
              var vals = ['2015-1-1', '2015-6-20', '2015-7-2', '2016-1-1'];
            $('#bar').data('ionRangeSlider').update({'values':vals})
            }, 5)})")))

))

server <- shinyServer(function(input, output, session) {  

})

shinyApp(ui = ui, server = server)

Or, if you prefer the values to be added on the server side:

library(shiny)

ui <- shinyUI(bootstrapPage(
  headerPanel("test"),

  sliderInput("bar", "bar dates", min=0, max=3, value=c(0,3)),
  uiOutput("bar_dates")
))

server <- shinyServer(function(input, output, session) {  

  values <- paste0("'", paste0(c('2015-1-1', '2015-6-20', '2015-7-2', '2016-1-1'), collapse="','"), "'")

  output$bar_dates <- renderUI({

    tags$head(tags$script(
      HTML(sprintf("
            $(function() {
              setTimeout(function(){
              var vals = [%s];
            $('#bar').data('ionRangeSlider').update({'values':vals})
            }, 5)})", values))))

  })
})

shinyApp(ui = ui, server = server)

Update

I've just seen your other question that is very similar to this, the answer of which has inspired quite a bit other code I've written.

Upvotes: 1

Related Questions