在 Shiny 中更改 dygraph 的 dyRangeSelector 的反应时间

Change reactive time for dygraph's dyRangeSelector in Shiny

我正在构建一个 Shiny 应用程序,我想在其中使用 dygraphs 中的 dyRangeSelector 来提供输入周期。

我的问题是,我只希望在选择器收到 "MouseUp" 事件时触发响应式更改,即,当用户 完成 选择时时期。现在,随着选择器的移动,事件被调度,这会导致应用程序滞后,因为每个周期的计算都需要几秒钟。从本质上讲,Shiny 对我的口味有反应(我知道这是错误的方式 - 通常我们希望应用程序具有超级反应性)。

我可以在分派响应式请求时进行修改吗?

这是一个说明问题的小例子。

library(quantmod)
library(shiny)
library(dygraphs)
library(magrittr)

# Create simple user interface
ui <- shinyUI(fluidPage(

    sidebarLayout(
    sidebarPanel(
            dygraphOutput("dygraph")
            ),    
    mainPanel(
            plotOutput("complicatedPlot")
            )
    )
))

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

    ## Read the data once.                                                                                       
    dataInput <- reactive({
    getSymbols("NASDAQ:GOOG", src = "google",
                   from = "2017-01-01",
                   auto.assign = FALSE)
    })

    ## Extract the from and to from the selector    
    values <- reactiveValues()    

    observe({
        if (!is.null(input$dygraph_date_window)) {
            rangewindow <- strftime(input$dygraph_date_window[[1]], "%Y-%m-%d")
            from <- rangewindow[1]
            to <- rangewindow[2]
        } else {
            from <- "2017-02-01"
            to <- Sys.Date()+1
        }
        values[["from"]] <- from
        values[["to"]] <- to
    })

    ## Render the range selector    
    output$dygraph <- renderDygraph({
        dygraph(dataInput()[,4]) %>% dyRangeSelector() %>% dyOptions(retainDateWindow = TRUE)
    })

    ## Render the "complicated" plot
    output$complicatedPlot <- renderPlot({
        plot(1,1)
        text(1,1, values[["from"]])
        Sys.sleep(1) ## Inserted to represent computing time
    })
})

## run app                                                                                                                                                                                                                         
runApp(list(ui=ui, server=server))

shiny 中有一个名为 debounce 的函数,它可能非常适合您的需要。如果将限制重写为反应式表达式(与观察相反),则可以将其包装到 debounce 中,并指定以毫秒为单位的时间,以便在评估前等待。这是一个 1000 毫秒的例子:

library(quantmod)
library(shiny)
library(dygraphs)
library(magrittr)

# Create simple user interface
ui <- shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      dygraphOutput("dygraph")
    ),    
    mainPanel(
      plotOutput("complicatedPlot")
    )
  )
))

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

  ## Read the data once.                                                                                       
  dataInput <- reactive({
    getSymbols("NASDAQ:GOOG", src = "google",
               from = "2017-01-01",
               auto.assign = FALSE)
  })

  ## Extract the from and to from the selector    
  values <- reactiveValues()    

  limits <- debounce(reactive({
    if (!is.null(input$dygraph_date_window)) {
      rangewindow <- strftime(input$dygraph_date_window[[1]], "%Y-%m-%d")
      from <- rangewindow[1]
      to <- rangewindow[2]
    } else {
      from <- "2017-02-01"
      to <- Sys.Date()+1
    }
    list(from = from,
         to = to)
  }), 1000)

  ## Render the range selector    
  output$dygraph <- renderDygraph({
    dygraph(dataInput()[,4]) %>% dyRangeSelector() %>% dyOptions(retainDateWindow = TRUE)
  })

  ## Render the "complicated" plot
  output$complicatedPlot <- renderPlot({
    plot(1,1)
    text(1,1, limits()[["from"]])
    Sys.sleep(1) ## Inserted to represent computing time
  })
})

## run app                                                                                                                                                                                                                         
runApp(list(ui=ui, server=server))

这基本上意味着响应式表达式必须在至少 1 秒内返回相同的值才能发送到其依赖项。您可以尝试最佳时间。