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

Question

在 Shiny 中，使用 updateSelectInput() 实现条件过滤器（其中过滤器 B 的选择table 取决于过滤器 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)

编辑：

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

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

Answer 1

在您的原始代码中，通过更改 input$species 使 iris_table 失效（然后重新呈现）一次。然后 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()，这将导致在指定时间 window 内忽略中间值。代码将如下所示：

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)

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

Prevent double loading of output when using updateSelectInput

r

shiny

shiny-reactivity