updateSliderInput с отсутствующими значениями Блестящая применения

Question

Мой кадр данных выглядит следующим образом:

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") 

Это выглядит следующим образом:

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 

Я создаю sliderInput, который динамически принимает значение столбца идентификаторов и позволяет пользователям перемещаться. Значения столбца id редко являются последовательными. Когда я запускаю слайдер, я получаю слайдер, но значения в слайдере возрастают с десятичными знаками. Как перейти непосредственно бегунок от 358 до 362 или 366 до 369. Моего кода до сих пор выглядит следующим образом:

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) 

Я не уверен, если минимальное и максимальное значение или значение шага должно быть изменен , Есть предположения?

Answer 1

Взгляните на это решение. Он использует пакет shinyjs. Заметим, что в этом случае ползунок возвращает индекс позиции, начиная с нуля. Чтобы использовать extendShinyjs из пакета shinyjs, вам необходимо установить пакет V8.

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()    
      }) 
    }) 

Позвольте мне знать, что это помогает ...