running background process in R Shiny

Question

I wrote a script that is supposed to run a background process if a button is pressed. After the process is finished, I would like to work further with the results.

Below is my script. The process in this script is 10 seconds sleeping followed by retrieving a list of the names of the files in the current folder. The background process is found in the function printLS(). This is performed in the background by the function 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)

In the app also a clock is shown. Unfortunately, the clock stops running when the background process is running. I would like the clock to continue to run during the background process. I tried this by removing 'global$result$wait()'. But then it looks if the background process is running for ever without providing ever any output (i.e. the list of files in the current folder).

My question is now: how can I get the clock to continue while the background process is running?

Answer 1

As explained in the examples here, wait() means that we have to wait for the result of the background job before continuing the rest of the processes.

One way to keep the clock updating while running the background job is to use poll_io() to check whether the job is finished (note that it is better to use poll_io() than is_alive(), as explained in this Github comment). I have done something similar in this question, although the general app is a bit more complicated.

Here's what you need to modify in the server:

  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>")))
    }
  })

Note that system2(command = "ls", args = c("-l"), stdout = TRUE, stderr = TRUE) didn't work on my laptop so I used system("ls -l") instead.