Async process blocking R Shiny app

Question

It should be possible to use the R packages future and promises to trigger asynchronous (long running) processing via Shiny apps without freezing t

Answer 1

As this or similar questions about shiny intra-session responsiveness are frequently asked on stackoverflow I think it's worth mentioning the workaround Joe Cheng provides in the GitHub issue @Raphvanns created:

If you really must have this kind of behavior, there is a way to work around it. You can "hide" the async operation from the Shiny session (allowing the session to move on with its event loop) by not returning your promise chain from your observer/reactive code. Essentially the async operation becomes a "fire and forget". You need to hook up a promise handler to have some side effect; in the example below, I set a reactiveVal on successful completion.

Some caveats to this approach:

1. By doing this you are inherently opening yourself up to race conditions. Even in this very simple example, the user can click the Submit button multiple times; if the long-running task has very variable runtime you might end up with multiple results coming back, but out of order. Or if you reference input values in promise handlers, they might pick up values that were set after the submit button was clicked!
2. You also lose the automatic semi-transparent indication that an output has been invalidated (though below I at least null the reactiveVal out in the beginning of the observeEvent).

Accordingly the solution for the above example code can be something like this:

library("shiny")
library("promises")
library("dplyr")
library("future")

# path containing all files, including ui.R and server.R
# setwd("/path/to/my/shiny/app/dir")

write.csv(data.frame(stringsAsFactors=FALSE,
                     Column1 = c("foo", "bar", "baz"),
                     Column2 = c(2, 5, 0)
), file = "./data.csv")

onStop(function() {
  file.remove("./data.csv")
})

plan(multiprocess)

# A function to simulate a long running process
read_csv_async = function(sleep, path){
  log_path = "./mylog.log"
  pid = Sys.getpid()
  write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process started"), file = log_path, append = TRUE)
  Sys.sleep(sleep)
  df = read.csv(path)
  write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process work completed\n"), file = log_path, append = TRUE)
  df
}

ui <- fluidPage(
  textOutput("parallel"),
  sliderInput(inputId = "hist_slider_val",
              label = "Histogram slider",
              value = 25, 
              min = 1,
              max = 100),
  plotOutput("userHist"),
  actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
  tableOutput("user_content")
)

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

  data_promise <- reactiveVal()

  # When button is clicked
  # load csv asynchronously and render table
  observeEvent(input$submit_and_retrieve, {
    future({ read_csv_async(10, "./data.csv") }) %...>% data_promise()
    return(NULL) # hide future
  })

  output$user_content <- renderTable({
    req(data_promise())
    head(data_promise(), 5)
  })

  # Render a new histogram 
  # every time the slider is moved
  output$userHist = renderPlot({
    hist(rnorm(input$hist_slider_val))
  })

  output$parallel <- renderText({
    invalidateLater(300)
    paste("Something running in parallel:", Sys.time())
  })

}

shinyApp(ui = ui, server = server)

Note the return(NULL) in the observeEvent call to hide the future. This way the long running process no longer blocks the execution of the other reactives.