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

让我知道这有帮助...

updateSliderInput在Shiny应用程序中缺少值

1 个答案: