R 我如何确保只有在所有其他反应完成更改后，才会更改闪亮的反应绘图？

我有一个闪亮的应用程序，用户在其中选择一组输入，例如x范围、y范围、缩放类型以及通过下拉列表选择数据集的特定子集

这都是通过使用反应剂来实现的。X和Y范围滑块输入对数据集选择中的更改作出反应，因为必须再次找到最小值和最大值。这可能需要约1-2秒，而闪亮的应用程序正在工作，用户在下拉列表中选择不同的选项。在这1-2秒钟内，当x和y范围滑块改变后，绘图将切换到使用旧的x和y范围绘制选定的新数据子集，然后快速切换到正确的绘图

一个解决办法是通过隔离其他所有内容来刷新按钮上的绘图。但是，有没有一种方法可以让绘图对变化保持反应，而只是等到所有相关的东西都计算完毕

谢谢

这是情节：

output$plot1 <- rCharts::renderChart2({    
    if(!is.null(input$date_of_interest) && 
         !is.null(input$xrange) && 
         !is.null(input$yrange) &&
         !is.null(data()) &&
         isolate(valid_date_of_interest())) {
      filtered_data<- dplyr::filter(isolate(data()), id==input$choice)
      p <- tryCatch(plot_high_chart(
                           data,
                           first_date_of_interest = input$date_of_interest, 
                           ylim = input$yrange,
                           xlim = input$xrange), 
                    error = function(e) e, 
                    warning = function(w) w)
      if(!inherits(p, "error") && !inherits(p, "warning")) {
        return(p)
      }
    } 
    return(rCharts::Highcharts$new())
  })

输出$plot1编辑2019-02-14
自Shining 1.0.0（在我最初编写此答案后发布）以来，现在有了一个
debounce
函数，它添加了帮助完成此类任务的功能。在大多数情况下，这避免了对我最初编写的代码的需要，尽管在后台它以类似的方式工作。然而，据我所知，
debounce
并没有提供任何方式，通过我在这里所做的重新绘制操作按钮来缩短延迟。因此，我创建了一个改进版的
debounce
，提供以下功能：

library(shiny)
library(magrittr)

# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL) 
{
  force(r)
  force(millis)
  if (!is.function(millis)) {
    origMillis <- millis
    millis <- function() origMillis
  }
  v <- reactiveValues(trigger = NULL, when = NULL)
  firstRun <- TRUE
  observe({
    r()
    if (firstRun) {
      firstRun <<- FALSE
      return()
    }
    v$when <- Sys.time() + millis()/1000
  }, label = "debounce tracker", domain = domain, priority = priority)
  # New code here to short circuit the timer when the short_circuit reactive
  # triggers
  if (inherits(short_circuit, "reactive")) {
    observe({
      short_circuit()
      v$when <- Sys.time()
    }, label = "debounce short circuit", domain = domain, priority = priority)
  }
  # New code ends
  observe({
    if (is.null(v$when)) 
      return()
    now <- Sys.time()
    if (now >= v$when) {
      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 
        1
      v$when <- NULL
    }
    else {
      invalidateLater((v$when - now) * 1000)
    }
  }, label = "debounce timer", domain = domain, priority = priority)
  er <- eventReactive(v$trigger, {
    r()
  }, label = "debounce result", ignoreNULL = FALSE, domain = domain)
  primer <- observe({
    primer$destroy()
    er()
  }, label = "debounce primer", domain = domain, priority = priority)
  er
}

服务器.R
库（闪亮）
shinyServer（功能（输入、输出、会话）{
reac
runApp（..，display.mode=“showcase”）
将突出显示正在运行的代码。可能这有助于您理解Hey Andriy，我了解程序在做什么，我只是不知道如何更改行为，以避免刷新绘图两次。好的。我想您可以添加一个
提交按钮
，这样选择器中的更改就不会引起您的反应在你按下sumbit按钮之前很多Hey Andriy，是的，这肯定会起作用，但我试着看看是否有办法避免使用按钮。很好的解决方案Nick，这也给我们上了一堂关于反应值的课。刚刚发现一个闪亮的函数（验证）现在可以使用它来完成任务：@ChriiSchee感谢您的反馈。我刚刚查看了validate，它看起来好像提供了一些不同的东西-它允许程序员检查所有输入是否有效，但不允许在更新值和重新计算输出之间有延迟。@NickKennedy很棒的解释+1.Given更改为shiny+future/Promissions，你今天还会这样攻击它吗？@JasonAizkalns感谢你的评论。我还没有在shiny中使用Promissions，但看起来它们解决了一个不同的问题；它们允许shiny流程更好地服务于多个用户，但在这里给出的示例中，它们无法避免以下问题：f当用户快速连续更改两个输入时，会出现冗余计算。感谢@NickKennedy——只是为了延迟，似乎需要大量的工作/维护。我遇到了反应数据的问题。帧对象（从滑块过滤）驱动（多个）绘图输出。这是可行的，但会增加很多开销。
 output$choice<- renderUI({
    selectInput("choice", 
                "Choose:", 
                unique(data$id),
                selected = 1    
    )
  })

library(shiny)
library(magrittr)

# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL) 
{
  force(r)
  force(millis)
  if (!is.function(millis)) {
    origMillis <- millis
    millis <- function() origMillis
  }
  v <- reactiveValues(trigger = NULL, when = NULL)
  firstRun <- TRUE
  observe({
    r()
    if (firstRun) {
      firstRun <<- FALSE
      return()
    }
    v$when <- Sys.time() + millis()/1000
  }, label = "debounce tracker", domain = domain, priority = priority)
  # New code here to short circuit the timer when the short_circuit reactive
  # triggers
  if (inherits(short_circuit, "reactive")) {
    observe({
      short_circuit()
      v$when <- Sys.time()
    }, label = "debounce short circuit", domain = domain, priority = priority)
  }
  # New code ends
  observe({
    if (is.null(v$when)) 
      return()
    now <- Sys.time()
    if (now >= v$when) {
      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 
        1
      v$when <- NULL
    }
    else {
      invalidateLater((v$when - now) * 1000)
    }
  }, label = "debounce timer", domain = domain, priority = priority)
  er <- eventReactive(v$trigger, {
    r()
  }, label = "debounce result", ignoreNULL = FALSE, domain = domain)
  primer <- observe({
    primer$destroy()
    er()
  }, label = "debounce primer", domain = domain, priority = priority)
  er
}

ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)
server <- function(input, output, session) {
  reac <- reactive(list(bins = input$bins, column  = input$column)) %>% 
    debounce_sc(5000, short_circuit = reactive(input$redraw))

  # Only triggered by the debounced reactive
  output$distPlot <- renderPlot({
    x    <- faithful[, reac()$column]
    bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         main = sprintf("Histogram of %s", reac()$column))
  })
}
shinyApp(ui, server)

library(shiny)
shinyUI(fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

library(shiny)
shinyServer(function(input, output, session) {
  reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column  = isolate(input$column))

  # If any inputs are changed, set the redraw parameter to FALSE
  observe({
    input$bins
    input$column
    reac$redraw <- FALSE
  })

  # This event will also fire for any inputs, but will also fire for
  # a timer and with the 'redraw now' button.
  # The net effect is that when an input is changed, a 5 second timer
  # is started. This will be reset any time that a further input is
  # changed. If it is allowed to lapse (or if the button is pressed)
  # then the inputs are copied into the reactiveValues which in turn
  # trigger the plot to be redrawn.
  observe({
    invalidateLater(5000, session)
    input$bins
    input$column
    input$redraw
    isolate(cat(reac$redraw, input$bins, input$column, "\n"))
    if (isolate(reac$redraw)) {
      reac$bins <- input$bins
      reac$column <- input$column
    } else {
      isolate(reac$redraw <- TRUE)
    }
  })

  # Only triggered when the copies of the inputs in reac are updated
  # by the code above
  output$distPlot <- renderPlot({
      x    <- faithful[, reac$column]
      bins <- seq(min(x), max(x), length.out = reac$bins + 1)
      hist(x, breaks = bins, col = 'darkgray', border = 'white',
           main = sprintf("Histogram of %s", reac$column))
  })
})