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

Question

我正在构建一个闪亮的应用程序，我想使用来自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))

Answer 1

shiny 中有一个名为debounce 的函数，它可能非常适合您的需求。如果将限制重写为反应式表达式（而不是观察），则可以将其包装到 debounce 中，并指定在评估之前等待的时间（以毫秒为单位）。下面是一个 1000ms 的例子：

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 秒内返回相同的值才能发送到其依赖项。您可以尝试最佳时间。