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 the rest of the app while the async process is running in another R process.

See:

https://cran.r-project.org/web/packages/promises/vignettes/intro.html
https://cran.r-project.org/web/packages/promises/vignettes/overview.html
https://cran.r-project.org/web/packages/promises/vignettes/futures.html
https://cran.r-project.org/web/packages/promises/vignettes/shiny.html

I got this to work in R-script-based environment but can't get this to work when I implement a simple shiny app with 2 functions. The "not-async" function is always blocked while the async function is running, but that should not be the case.

I have posted the same question on the GitHub repo of the package promises: https://github.com/rstudio/promises/issues/23

I am posting it here as well hoping someone can help.

The question is:

1. Can you take a look at the shiny app example posted below and let me know why the async processing is blocking the app? (It should not block).
2. Ideally, can you provide a small example of an app with a non-blocking async and normal functionality (accessible while the async is running)?

Environment

Mac OS 10.12

$ R --version
R version 3.4.3 (2017-11-30) -- "Kite-Eating Tree"

remove.packages("future")
remove.packages("promises")
remove.packages("shiny")

install.packages("future")
install.packages("devtools")
devtools::install_github("rstudio/promises")
devtools::install_github("rstudio/shiny")

> packageVersion("future")
[1] ‘1.8.1’
> packageVersion("promises")
[1] ‘1.0.1’
> packageVersion("shiny")
[1] ‘1.0.5.9000’

One side question on the shiny package version, https://rstudio.github.io/promises/articles/intro.html says it should be >=1.1, but even installing with devtools, the version remains 1.0.5... . Is this an issue or is there a typo in the doc?

First, you can use promises with Shiny outputs. If you’re using an async-compatible version of Shiny (version >=1.1), all of the built-in renderXXX functions can deal with either regular values or promises.

Example of issue

I have implemented this simple shiny app inspired from the example at the URLs mentioned above. The shiny app has 2 "sections":

1. A button to trigger the "long running" async processing. This is simulated by a function read_csv_async which sleeps for a few seconds, reads a csv file into a data frame. The df is then rendered below the button.
2. A simple functionality which should work at any time (including when the async processing has been triggered): it includes a slider defining a number of random values to be generated. We then render a histogram of these values.

The issue is that the second functionality (histogram plot update) is blocked while the async processing is occurring.

global.R

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

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.R

fluidPage(
  actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
  br(),
  br(),
  tableOutput("user_content"),

  br(),
  br(),
  br(),
  hr(),

  sliderInput(inputId = "hist_slider_val",
              label = "Histogram slider",
              value = 25, 
              min = 1,
              max = 100),

  plotOutput("userHist")
)

server.R

function(input, output){
    # When button is clicked
    # load csv asynchronously and render table
    data_promise = eventReactive(input$submit_and_retrieve, {
        future({ read_csv_async(10, "./data.csv") }) 
    })
   output$user_content <- renderTable({
     data_promise() %...>% head(5)
    })


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

data.csv

Column1,Column2
foo,2
bar,5
baz,0

Thanks!

Sketch

For your side question, I'm guessing that's a "cart before the horse" problem, meaning that they documented the need for 1.1 before it's available. You can find it here: github.com/rstudio/shiny/tree/v1.1.0-rc – Refusal

OK, this could make sense. Thanks! – Sketch

Answer 1

So this behavior is normal, see the response of the package developer at https://github.com/rstudio/promises/issues/23

Summary:

In shiny apps, one R process can be shared by multiple users. If one user submits a long running task, then all the other users sharing the same underlying R process are blocked. The goal of promises is to avoid this. So promises will prevent blocking between "user sessions" within one R process but not within a single "user session".

The author of the package mentioned that this feature is not supported yet and that it may be added if enough people ask for it. If you are looking for this, please go the GitHub issue and like the original question - this is how interest for new features is measured.

Thanks!

Sketch

Answer 2

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.

Ormand