Как я могу убедиться, что блестящий реактивный сюжет изменяется только после того, как все остальные реагирующие изменения закончатся?

У меня есть блестящее приложение, в котором пользователь выбирает множество входов, таких как диапазон 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())
  })

и диапазон x (диапазон y аналогичен):

output$xrange <- renderUI({
    if(!is.null(input$date_of_interest) && 
       !is.null(input$choice) &&
       !is.null(valid_date_of_interest()) &&
       isolate(valid_date_of_interest())) {
          temp_data <- dplyr::filter(isolate(data()), date == input$date_of_interest)
          temp <- data.table::data.table(temp_data, key = "child.id")
          the_days <- as.double(as.Date(temp$last.tradeable.dt) - as.Date(temp$date))
          min_days <- min(the_days,na.rm=TRUE)
          max_days <- max(the_days,na.rm=TRUE)
          sliderInput("xrange", 
                      "Days Range (X Axis)", 
                       step = 1,
                       min = 0,
                       max = max_days + 10,
                       value = c(min_days,max_days)
      )
    }
  })

и выбор входа:

 output$choice<- renderUI({
    selectInput("choice", 
                "Choose:", 
                unique(data$id),
                selected = 1    
    )
  })

Некоторое направление и предложения по внедрению будут полезны. Я подумал о том, что глобальные переменные, такие как x_range_updated, y_range_updated, установлены в false для кода для вывода $choice, а затем заданы значение true в коде для вывода $xrange и т.д. И тогда зависимость plot1 зависит от их истинности, Другие предложения по решению этой проблемы будут оценены.

Ответы

Ответ 1

Вы не представили воспроизводимый пример, поэтому я пошел с чем-то на основе блестящего верного примера, который по умолчанию используется в RStudio. Решение, которое у меня есть, всегда будет иметь (настраиваемую) 5-секундную задержку между изменением ввода и перерисованием графика. Каждое изменение ввода сбрасывает таймер. Также есть кнопка перерисовывания для нетерпения, которая сразу же перерисовывает график. Значения "перерисовки" реактивного значения и входов отображаются на консоли каждый раз, когда изменяется вход или гаснет таймер. Это необходимо удалить для использования в производстве. Надеюсь, это соответствует вашим потребностям!

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")
    )
  )
))

server.R

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