updateSliderInput with missing values in Shiny application

Question

My data frame is as follows:

df <- structure(list(id = c(358L, 362L, 363L, 366L, 369L), Time_of_visit = c("DAY", 
"DAY", "DAY", "DAY", "DAY"), PropertyCode = c(7627, 7627, 7627, 
7627, 7627)), .Names = c("id", "Time_of_visit", "PropertyCode"
), row.names = c(61L, 65L, 66L, 69L, 72L), class = "data.frame")

It looks like this:

   id Time_of_visit PropertyCode
61 358           DAY         7627
65 362           DAY         7627
66 363           DAY         7627
69 366           DAY         7627
72 369           DAY         7627

I am creating a sliderInput that dynamically takes the value of the id column and allows the users to slide through. The values of id column are rarely sequential. When I run the slider, I get the slider, but the values in the slider increases in decimals. How do I directly jump the slider from 358 to 362 or 366 to 369. My code so far looks like this:

library(shiny)

ui <- fluidPage(
  sliderInput('myslider','PICTURES',min = 0, max = 1, value = 1,step = NULL, animate=animationOptions(interval = 1000,loop=F))
)

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

    dff <- reactive({df})

    observe({
    updateSliderInput(session, "myslider", label = "PICTURES", value = 1,step = NULL,min = min(dff()$id), max = max(dff()$id))
    })

}

shinyApp(ui = ui, server = server)

I am not sure, if the min and max values or the step values should be be changed. Any thoughts?

Valter Beaković Valter Beaković · Accepted Answer · 2016-10-28T14:05:17

Take a look at this solution. It uses the shinyjs package. Just note that in this case the slider returns the index of the position starting from zero. To use extendShinyjs from shinyjs package you need to install the V8 package.

ui.R

    library(shiny)
    library(shinyjs)
    jsCode <- "shinyjs.ticksNum = function(RangeOfValues){var slider = $('#sliderExample').data('ionRangeSlider'); var a = String(RangeOfValues).split(','); slider.update({
        values: a
    })}"



    shinyUI(tagList(
            useShinyjs(),
            extendShinyjs(text = jsCode),
            tags$head(
            ),
            fluidPage(


      titlePanel("Custom ticks"),


      sidebarLayout(
        sidebarPanel(
                selectInput("dataFrame", "Select data frame", choices = c("DF1", "DF2"), selected = "DF1"),
                sliderInput("sliderExample", "Slider", min = 0, max = 10, step = 1, value = 5)


        ),


        mainPanel(
                verbatimTextOutput("check"),
                verbatimTextOutput("sliderValue")
        )
      )
    )))

server.R

    library(shiny)
    library(shinyjs)


    df1 <- structure(list(id = c(358L, 362L, 363L, 366L, 369L), 
                          Time_of_visit = c("DAY", "DAY", "DAY", "DAY", "DAY"), 
                          PropertyCode = c(7627, 7627, 7627, 7627, 7627)), 
                     .Names = c("id", "Time_of_visit", "PropertyCode"), 
                     row.names = c(61L, 65L, 66L, 69L, 72L), class = "data.frame")
    df2 <- structure(list(id = c(454L, 550L, 580L, 600L, 710L), 
                          Time_of_visit = c("DAY", "DAY", "DAY", "DAY", "DAY"), 
                          PropertyCode = c(7627, 7627, 7627, 7627, 7627)), 
                     .Names = c("id", "Time_of_visit", "PropertyCode"), 
                     row.names = c(61L, 65L, 66L, 69L, 72L), class = "data.frame")



    # Define server logic required to draw a histogram
    shinyServer(function(input, output) {

            selectedDf <- reactive({
                    if (input$dataFrame == "DF1") {
                            return(df1)
                    } else {
                            return(df2)
                    }
            })

            observeEvent(selectedDf(), {

                    js$ticksNum(selectedDf()$id)

            })
            output$check <- renderPrint({
                    selectedDf() 
            }) 
            selectedId <- reactive({
                    tmp <- selectedDf()
                    tmp[input$sliderExample + 1, ]
            })
            output$sliderValue <- renderPrint({
                    selectedId()               
            })
    })

Let me know of this helps...

updateSliderInput with missing values in Shiny application

1 Answers