使用 updateSelectInput 时防止双重加载输出

Question

在 Shiny 中，使用updateSelectInput() 实现条件过滤器（其中过滤器 B 的可选选择取决于过滤器 A）是许多问题（如 here）的公认解决方案。然而，在实现它时，我经常遇到输出对象加载两次，这在小数据集上不可见，但在真正的大数据集上是可见的。

我在下面的iris 数据集上生成了一个最小示例，Sys.sleep() 表示显示双重负载的耗时操作。

防止这种情况发生的最佳方法是什么？我觉得在某个地方有一个好的 req() 应该可以解决问题，但我不知道如何以及在哪里。

library(shiny)
library(dplyr)

ui <- fluidPage(
      selectInput("species", "Species", choices=levels(iris$Species)),
      selectInput("petal_width", "Petal Width", ""),
      tableOutput("iris_table")
)

server <- function(session, input, output) {
  output$iris_table <- renderTable({
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == input$species,
             Petal.Width == input$petal_width)
  })

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observe({
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })
}

shinyApp(ui, server)

编辑：

更具体地说：如果您运行应用程序并更改顶部（物种）选择器的值，例如对于 versicolor，可能的底部选择器（花瓣宽度）选项会相应改变，这就是我想要的。

您还可以看到输出表将加载（渲染可能是一个更好的术语）两次。我假设它这样做是因为首先更新物种选择器的执行顺序，而不是表一次（在这种情况下暂时导致一个空表）和底部选择器大约同时一次，然后表再次调整到新的底部选择器值。我希望表格只在两个选择器值都完成更新时呈现一次。

Answer 1

在您的原始代码中，iris_table 通过更改 input$species 已失效（然后重新呈现）一次。然后input$pedal_width 通过observeEvent 更新，这又使iris_table 第二次失效（然后重新渲染）。

使用isolate() 应该可以解决您的问题，而无需操作按钮（这将是一个有效的替代方案）。

在renderTable 调用中隔离input$species 可防止iris_table 在input$species 更改时失效（进而重新呈现）。似乎隔离input$species 会阻止iris_table 在仅更改物种时被更新，但是，由于更改input$species 总是更新input$petal_width，iris_table 也将在用户仅选择另一个物种时重新呈现.

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  tableOutput("iris_table")
)

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

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observeEvent(petal_width_options(),{
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })


  output$iris_table <- renderTable({
    req(input$petal_width)
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == isolate(input$species),
             Petal.Width == input$petal_width)


  })


}

shinyApp(ui, server)

您也可以使用操作按钮来完成。

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  actionButton("render", "update table"),
  tableOutput("iris_table")
)

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

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observeEvent(petal_width_options(),{
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })


  output$iris_table <- renderTable({
    input$render
    req(isolate(input$petal_width))
    Sys.sleep(2)  # to show the double loading time
    iris %>%
      filter(Species == isolate(input$species),
             Petal.Width == isolate(input$petal_width))


  })



}

shinyApp(ui, server)

Answer 2

所以在我的情况下，isolate() 解决方案不起作用，因为对于我的数据，过滤器值不一定会改变。

另一种解决方案是使用debounce()，这将导致指定时间窗口的中间值被忽略。代码将如下所示：

library(shiny)
library(dplyr)

ui <- fluidPage(
  selectInput("species", "Species", choices=levels(iris$Species)),
  selectInput("petal_width", "Petal Width", ""),
  tableOutput("iris_table")
)

server <- function(session, input, output) {
  output$iris_table <- renderTable({
    Sys.sleep(2)  # to show the double loading time
    iris_filtered()
  })

  iris_filtered <- reactive({
    iris %>%
      filter(Species == input$species,
             Petal.Width == input$petal_width)
  }) %>% debounce(100)

  petal_width_options <- reactive({
    iris$Petal.Width[iris$Species == input$species]
  })

  observe({
    updateSelectInput(session, "petal_width", choices = petal_width_options())
  })
}

shinyApp(ui, server)