r - 如何在 R 中使操作不间断

Question

在我 Shiny 的应用程序中，我有一个应该不断更新的输出。但是每当我执行长时间运行的计算时，输出就会暂停。我的问题是:如何让输出连续不间断地运行？

请参阅下面的简短演示:
时钟每隔一秒刷新一次，但如果我单击运行 5 秒的按钮，时钟将暂停。

library(shiny)

ui <- fluidPage(
    actionButton("button","Expensive calcualtion(takes 5 seconds)"),
    tags$p("Current Time:"),
    textOutput("time"),
    tags$p("Result from clicking button:"),
    textOutput("result")
)

server <- function(input, output, session) {
    output$time <- renderText({
        invalidateLater(1000)
        as.character(Sys.time())
    })

    observeEvent(input$button,{
        Sys.sleep(5)
        output$result <- renderText(runif(1))
  })
}

shinyApp(ui, server)

我尝试使用 future和 promises使长时间运行的进程异步运行，但它不起作用。哪里错了？有没有更好的方法来实现这个目的？

library(shiny)
library(future)
library(promises)
plan("multisession")

ui <- fluidPage(
    actionButton("button","Expensive calcualtion(takes 5 seconds)"),
    tags$p("Current Time:"),
    textOutput("time"),
    tags$p("Result from clicking button:"),
    textOutput("result")
)

server <- function(input, output, session) {
    output$time <- renderText({
        invalidateLater(1000)
        as.character(Sys.time())
    })

    process <- eventReactive(input$button,{
        future({
            Sys.sleep(5)
            runif(1)
        })
    })

    output$result <- renderText(process())

}

shinyApp(ui, server)

任何帮助表示赞赏!

Answer 1

感谢@Shree 指出解决方案。看完response从乔郑。似乎关键是:

Hide the async operation from Shiny by not having the promise be the last expression.

该问题通过创建一个 react 值并在 observeEvent 中为其分配 promise 来解决。作为副作用。

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

  output$time <- renderText({
    invalidateLater(1000)
    as.character(Sys.time())
  })

  process <- reactiveVal()

  observeEvent(input$button,{
    output$isbusy <- renderText("busy") # a simple busy indicator
    future({
      Sys.sleep(5)
      runif(1)
    }) %...>%
      process()
    # Hide the async operation from Shiny by not having the promise be the last expression
    NULL # important
  })

  output$result <- renderText({
    output$isbusy <- renderText("") # a simple busy indicator
    process()
  })
}