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列的值並允許用戶滑過。 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包。請注意，在這種情況下，滑塊返回從零開始的位置索引。 要使用shinyjs包中的extendShinyjs，您需要安裝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()    
      }) 
    }) 

讓我知道這會有所幫助...