在 Shiny 中使用 InvalidateLater 和反应事件与 observeEvent

Question

我正在尝试在 UI 上显示定期更新，以获得可能持续数小时的实时数据馈送。我在下面的代码中找到了一个使用 Shiny observe 函数进行这种反应的很好的例子。

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 一些参数并单击按钮以启动实时数据馈送。当我尝试通过将 observe 函数更改为 observeEvent 函数来修改上面的代码时，我似乎无法让它工作，我也不知道为什么。当我运行我的版本（见下面的代码）时，它不提供有关其进度的定期更新，而是等到它完成更新 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

我认为很难在 observeEvent 内完成，所以我坚持使用 observe 和 isolate 的原始方法。在玩弄它之后，我想出了下面的解决方案，但我认为它可以简化。这个解决方案的一个优点是，在第一次点击“开始”按钮后，下一个运行也会通过点击“开始”而不是运行在输入更新时自动触发。此外，当 input$iterations 更新时，100% 标签不会更改，但只会在单击 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)

Answer 2

问题是 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)
    }
  })

在 Shiny 中使用 InvalidateLater 和反应事件与 observeEvent

Using InvalidateLater and reactive events with observeEvent in Shiny

r

reactive-programming

shiny