r - 使用 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)

编辑:

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

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

Answer 1

在您的原始代码中 iris_table通过更改 input$species 无效(然后重新渲染)一次.然后input$pedal_width已通过 observeEvent 更新这反过来无效(然后重新渲染)iris_table第二次。

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

隔离input$species在 renderTable调用阻止 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)