запуск фонового процесса в R Shiny

Question

Я написал скрипт, который должен запускать фоновый процесс при нажатии кнопки. После завершения процесса хотелось бы продолжить работу с результатами.

Ниже мой скрипт. Процесс в этом скрипте засыпает на 10 секунд, после чего извлекается список имен файлов в текущей папке. Фоновый процесс находится в функции printLS(). Это выполняется в фоновом режиме функцией r_bg().

      library(shiny)
library(callr)

ui <- fluidPage(
  textOutput("clock"), br(), 
  actionButton("startjob","Start Job"), br(), br(), 
  uiOutput("LS")
)

server <- function(input, output, session) 
{
  output$clock <- renderText({
    invalidateLater(1)
    format(Sys.time(), "%d %b %H:%M:%S")
  })

  global <- reactiveValues(result = NULL)

  printLS <- function() {
    Sys.sleep(10)
    result <- system2(
      command = "ls",
      args    = c("-l"),
      stdout  = TRUE,
      stderr  = TRUE
    )
  }

  observeEvent(input$startjob, {
    global$result <- r_bg(func = printLS, supervise = F)
    global$result$wait()
  })

  output$LS <- renderUI({
    req(global$result)

    if (!global$result$is_alive())
      p(HTML(paste(global$result$get_result(), sep = "", collapse = "<br>")))
  })
}

shinyApp(ui = ui, server = server)

В приложении также отображаются часы. К сожалению, часы перестают работать, когда запущен фоновый процесс. Я хотел бы, чтобы часы продолжали работать во время фонового процесса. Я попробовал это, удалив «global$result$wait()». Но тогда кажется, что фоновый процесс работает вечно, не предоставляя никаких выходных данных (например, список файлов в текущей папке).

Теперь мой вопрос: как я могу заставить часы продолжать работать, пока фоновый процесс работает?

Answer 1

Как объяснено в примерах здесь , wait()означает, что мы должны дождаться результата фонового задания, прежде чем продолжить остальные процессы.

Один из способов поддерживать актуальность часов во время выполнения фонового задания — использовать проверку того, завершено ли задание (обратите внимание, что лучше использовать poll_io()чем is_alive(), как объясняется в этом комментарии Github ). Я сделал что-то подобное в этом вопросе , хотя общее приложение немного сложнее.

Вот что вам нужно изменить на сервере:

        observeEvent(input$startjob, {
    global$result <- r_bg(func = printLS, supervise = F)
  })
  
  output$LS <- renderUI({
    req(input$startjob)
    if (global$result$poll_io(0)["process"] == "timeout") {
      invalidateLater(1000)
    } else {
      p(HTML(paste(global$result$get_result(), sep = "", collapse = "<br>")))
    }
  })

Обратите внимание, что system2(command = "ls", args = c("-l"), stdout = TRUE, stderr = TRUE)не работал на моем ноутбуке, поэтому я использовал system("ls -l")вместо.