在 Shiny 中使用 InvalidateLater 和带有 observeEvent 的反应事件

Question

我正在尝试在 UI 上显示可能持续数小时的实时数据馈送的定期更新。 我发现了一个很好的例子，用 Shiny 在下面的代码中观察 function 进行这种反应。

library(shiny)
ui <- pageWithSidebar(
  
  # Application title
  headerPanel("New Application"),
  
  sidebarPanel(
    "Progress: ",
    textOutput("counter"),
    hr(),
    "Elapsed Time (seconds):",
    textOutput("elapsed")
  ),
  
  mainPanel(
    textOutput("x")
  )
)

server <- function(input, output, session) {
  # The number of iterations to perform
  maxIter <- 50
  
  # Track the start and elapsed time
  startTime <- Sys.time()  
  output$elapsed <- renderText({
    vals$x
    round(Sys.time() - startTime)
  })
  
  # Create a reactiveValues object where we can track some extra elements
  # reactively.
  vals <- reactiveValues(x = 0, counter = 0)
  
  # Update the percentage complete
  output$counter <- renderText({
    paste0(round(vals$counter/maxIter * 100, 1), "%")
  })
  
  # Show the value of x
  output$x <- renderText({
    round(vals$x,2)
  })
  
  # Do the actual computation here.
  observe({
    isolate({
      # This is where we do the expensive computing
      sum <- 0
      for (i in 1:100000){
        sum <- sum + rnorm(1)
      }
      vals$x <- vals$x + sum
      
      # Increment the counter
      vals$counter <- vals$counter + 1  
    })
    
    # If we're not done yet, then schedule this block to execute again ASAP.
    # Note that we can be interrupted by other reactive updates to, for
    # instance, update a text output.
    if (isolate(vals$counter) < maxIter){
      invalidateLater(0, session)
    }
  })
  
}

shinyApp(ui, server)

这个代码示例提供了定期的 UI 更新，就像我想看到的那样，除了我想 select 一些参数并单击一个按钮以启动实时数据馈送。 当我尝试通过将观察 function 更改为观察事件 function 来修改上面的代码时，我似乎无法让它工作，我不知道为什么。 当我运行我的版本时（参见下面的代码），它不会提供有关其进度的定期更新，而是等到它完成更新 UI。 这是我的代码：

library(shiny)

ui <- pageWithSidebar(
  
  # Application title
  headerPanel("New Application"),
  
  sidebarPanel(
    numericInput("startNumber","Start Number",value=0),
    numericInput("iterations","Interations",value=5),
    actionButton(inputId = "go",label="Go"),
    br(),
    "Progress: ",
    textOutput("counter"),
    hr(),
    "Elapsed Time (seconds):",
    textOutput("elapsed")
  ),
  
  mainPanel(
    textOutput("x")
  )
)

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

  # Track the start and elapsed time
  startTime <- Sys.time()  
  output$elapsed <- renderText({
    vals$x
    round(Sys.time() - startTime)
  })
  
  # Create a reactiveValues object where we can track some extra elements
  # reactively.
  vals <- reactiveValues(x = 0, counter = 0)
  
  # Update the percentage complete
  output$counter <- renderText({
    paste0(round(vals$counter/input$iterations * 100, 1), "%")
  })
  
  # Show the value of x
  output$x <- renderText({
    round(vals$x,2)
  })
  
  # Do the actual computation here.
  observeEvent (input$go,
    {
      # The number of iterations to perform
      while (vals$counter < isolate(input$iterations)) {
        #isolate({
          # This is where we do the expensive computing
          sum <- input$startNumber
          for (i in 1:100000){
            sum <- sum + rnorm(1)
          }
          vals$x <- vals$x + sum
      
          # Increment the counter
          vals$counter <- vals$counter + 1  
        #})
    
        # If we're not done yet, then schedule this block to execute again ASAP.
        # Note that we can be interrupted by other reactive updates to, for
        # instance, update a text output.
        if (vals$counter < isolate(input$iterations)){
          invalidateLater(0, session)
        }
      }
    })
  
}

shinyApp(ui, server)

我很确定我错过了一个重要的概念，但我很困惑。

Answer 1

问题是invalidateLater仅在反应式上下文中起作用。 observeEvent将其所有内部结构都包装在隐含的isolate中，使其无反应。

这个观察应该做

  observe({
    req(input$go)
    isolate({
      # This is where we do the expensive computing
      sum <- 0
      for (i in 1:100000){
        sum <- sum + rnorm(1)
      }
      vals$x <- vals$x + sum
      
      # Increment the counter
      vals$counter <- vals$counter + 1  
    })
    
    # If we're not done yet, then schedule this block to execute again ASAP.
    # Note that we can be interrupted by other reactive updates to, for
    # instance, update a text output.
    if (isolate(vals$counter < input$iterations)){
      invalidateLater(0, session)
    }
  })

Answer 2

我认为在observeEvent中很难做到这一点，所以我坚持使用observe和isolate的原始方法。 在玩弄它之后，我想出了下面的解决方案，但我认为它可以简化。 此解决方案的一个优点是，在第一次单击“开始”按钮后，下一次运行也会通过单击“开始”来触发，而不是在输入更新时自动运行。 此外，当input$iterations更新时，100% label 不会改变，但只会在点击go后改变。 也可以将第二次运行中的迭代次数设置为较低的值。

library(shiny)

ui <- pageWithSidebar(
  
  # Application title
  headerPanel("New Application"),
  
  sidebarPanel(
    numericInput("startNumber","Start Number",value=0),
    numericInput("iterations","Interations",value=5),
    actionButton(inputId = "go",label="Go"),
    br(),
    "Progress: ",
    textOutput("counter"),
    hr(),
    "Elapsed Time (seconds):",
    textOutput("elapsed")
  ),
  
  mainPanel(
    textOutput("x")
  )
)

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

  # Create a reactiveValues object where we can track some extra elements
  # reactively.
  vals <- reactiveValues(x = 0,
                         counter = 0,
                         go_btn = NULL,
                         itr = NULL,
                         tstart = NULL)
  
  
  # Track the start and elapsed time
    
  output$elapsed <- renderText({
    req(vals$tstart)
    vals$x
    round(Sys.time() - vals$tstart)
  })

  # Update the percentage complete
  output$counter <- renderText({
    req(vals$itr)
    paste0(round(vals$counter/ vals$itr * 100, 1), "%") 
  })
  
  # Show the value of x
  output$x <- renderText({
    round(vals$x,2)
  })
  
  observeEvent(input$go, {
    if (is.null(vals$go_btn)) {
      vals$counter <- 0
      vals$go_btn <- 0
      vals$itr <- input$iterations
      vals$tstart <- Sys.time()  
    } else {
      vals$go_btn <- vals$go_btn + 1
    }
  })
  
  # Do the actual computation here.
  observe({vals$go_btn
    req(vals$go_btn)
    isolate({    
      if (vals$counter < input$iterations){
        sum <- input$startNumber 
        for (i in 1:100000){
          sum <- sum + rnorm(1)
        }
        vals$x <- vals$x + sum
        
        vals$counter <- vals$counter + 1  
      } # close if
    }) # close isolate
    if (isolate(vals$counter < input$iterations)){
      invalidateLater(0, session)
    } else {
      isolate({   
        vals$go_btn <- NULL
      })
    }
    
  }) # close observe
  
}

shinyApp(ui, server)