如何让 Shiny 在处理来自 UI 输入的更新之前等待一段时间？

Question

我正在编写过滤器并在每次应用新过滤器时汇总数据的应用程序。因为其中一个过滤器是具有相当大基数（> 10,000）的搜索框，并且由于源数据中的总行数很大，并且已经部分汇总，所以它可能需要一段时间才能更新。 我希望有一个缓冲期，应用程序等待用户输入结束，例如，在实际开始更新过程之前 1-2 秒。

这是一个简单的示例（没有高基数），如果您以相对较快的速度连续切换不同的选项，您将看到几个中间图。如果增加N，效果会更强、更明显（也更烦人）。这里的瓶颈很可能是图形生成与数据处理，但总体概念是相同的。

library(shiny)

ui <- fluidPage(
  titlePanel('Example Title'),
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput(
        'yFilterCheckbox',
        label='Filter Checkbox',
        choices = c('y<=-1','-1<y<1','y>=1'),
        selected = c('y<=-1','-1<y<1','y>=1'),
      ),
      checkboxGroupInput(
        'cat1FilterCheckbox',
        label='Category 1 Filter',
        choices=LETTERS[1:4],
        selected=LETTERS[1:4]
      ),
      checkboxGroupInput(
        'cat2FilterCheckbox',
        label='Category 2 Filter',
        choices=c('BIG','SMALL'),
        selected = c('BIG','SMALL')
      )
    ),
    mainPanel(
      plotOutput('myPlot')
    )
  )
)

server <- function(input, output){
  library(tidyverse)
  set.seed(2021*12*21)
  N=200000
  mydata = data.frame(
    x1 = rnorm(N),
    x2 = rnorm(N),
    x3 = rnorm(N),
    c1 = sample(LETTERS[1:4], N, replace=T),
    c2 = sample(c('BIG','SMALL'), N, replace=T)
  ) %>%
    mutate(
      y1 = x1 * (1 + (c1 == 'D')) + 
       x2 * (1 - (c1 == 'C')) +
       (x3 - rnorm(N)) * (1 + 3 * (c2 == 'BIG')),
      z1 = 1 * (y1 > 0)
    )

  output$myPlot <- renderPlot({
    ggplot(
      mydata %>%
        filter(
          c1 %in% input$cat1FilterCheckbox &
          c2 %in% input$cat2FilterCheckbox &
          case_when(
            y1 <= -1 ~ 'y<=-1' %in% input$yFilterCheckbox,
            y1 > -1 & y1 < 1 ~ '-1<y<1' %in% input$yFilterCheckbox,
            TRUE ~ 'y>=1' %in% input$yFilterCheckbox
          )
        )
      ) +
      geom_point(
        aes(x=x1,y=y1, color=c1, shape=c2)
      ) + theme_bw()
    })
}

shinyApp(ui=ui, server=server)

Answer 1

您描述了debouncing，您在其中对输入进行去抖动处理，以便相关组件不会看到快速变化。

我认为你有两个选择：

1. 将每个需要去抖动的input$ 替换为新的reactive(input$.) %>% debounce(1000)。这意味着如果用户从一个组切换到另一个组并返回，它可以更轻松地循环，这可能不是我们所希望的。

     yFilter_d <- reactive({
       input$yFilterCheckbox
     }) %>% debounce(1000)
     cat1Filter_d <- reactive({
       input$cat1FilterCheckbox
     }) %>% debounce(1000)
     cat2Filter_d <- reactive({
       input$cat2FilterCheckbox
     }) %>% debounce(1000)
   
     output$myPlot <- renderPlot({
       ggplot(
         mydata %>%
           filter(
             c1 %in% cat1Filter_d() &
             c2 %in% cat2Filter_d() &
             case_when(
               y1 <= -1 ~ 'y<=-1' %in% yFilter_d(),
               y1 > -1 & y1 < 1 ~ '-1<y<1' %in% yFilter_d(),
               TRUE ~ 'y>=1' %in% yFilter_d()
             )
           )
         ) +
         geom_point(
           aes(x=x1,y=y1, color=c1, shape=c2)
         ) + theme_bw()
       })
   

2. 将所有输入组合成一个reactive(.) %>% debounce(1000)，返回一组命名列表：

     allFilter_d <- reactive({
       list(yFilter = input$yFilterCheckbox,
            cat1Filter = input$cat1FilterCheckbox,
            cat2Filter = input$cat2FilterCheckbox)
     }) %>% debounce(1000)
   
     output$myPlot <- renderPlot({
       filts <- allFilter_d()
       ggplot(
         mydata %>%
           filter(
             c1 %in% filts$cat1Filter &
             c2 %in% filts$cat2Filter &
             case_when(
               y1 <= -1 ~ 'y<=-1' %in% filts$yFilter,
               y1 > -1 & y1 < 1 ~ '-1<y<1' %in% filts$yFilter,
               TRUE ~ 'y>=1' %in% filts$yFilter
             )
           )
         ) +
         geom_point(
           aes(x=x1,y=y1, color=c1, shape=c2)
         ) + theme_bw()
       })
   

旁注：根据实际应用中的输入数量，您可能还想利用bindCache：

  output$myPlot <- renderPlot({
    # ...
  }) %>% bindCache(allFilter_d())

这样做，虽然您在更改复选框参数时会获得正常（现在改进）的延迟，但当用户重新访问以前查看的输入组合时，绘图会更快地呈现。 （我不知道有一种方法可以预先缓存这些图，而不是自动地在shiny-接口内。那当然很好，但不能推广到shiny 需要的程度。）