Async process blocks shiny app within "user session"

[raphaelvannson]

Hello,

I am having trouble making a simple shiny app with a non-blocking async process.
I am not a beginner in R or multi-process programming, read the documentation thoroughly yet I cannot get this to work how it should so I am posting a question here in the hopes you can help me figure out what I am doing wrong.

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 URL mentioned above and the vignettes mentioned below.
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 = read.csv(path)
      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){
   parent_pid = Sys.getpid()

    # 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

Question

I can't get the non-blocking async processing to work in shiny: the histogram update is always blocked while the async process is running.
I have tried other strategies involving observeEvent() or even simpler examples with the same resutls.
Can you provide a simple example of a shiny app including a non-blocking example of an async processing or let me know what I am doing wrong here?

I have thoroughly read the vignettes listed below:
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

Thanks!

[jcheng5]

Thanks for the detailed and thoughtful issue report. I suspect you won't like this answer, but this behavior is by design. I go into some detail about how this works in this section of the docs: https://rstudio.github.io/promises/articles/shiny.html#the-flush-cycle

The goal, at least for this release of Shiny, is not to allow this kind of intra-session responsiveness, but rather, inter-session; i.e., running an async operation won't make its owning session more responsive, but rather will allow other sessions to be more responsive.

---

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

library("shiny")
library("promises")
library("dplyr")
library("future")
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 = read.csv(path)
  df
}

ui <- 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 <- function(input, output){
  parent_pid = Sys.getpid()
  
  # When button is clicked
  # load csv asynchronously and render table
  data <- reactiveVal()
  observeEvent(input$submit_and_retrieve, {
    data(NULL)
    future({ read_csv_async(10, "./data.csv") }) %...>%
      data() %...!%  # Assign to data
      (function(e) {
        data(NULL)
        warning(e)
        session$close()
      })
    
    # Hide the async operation from Shiny by not having the promise be
    # the last expression.
    NULL
  })
  output$user_content <- renderTable({
    req(data()) %>% head(5)
  })
  
  
  # Render a new histogram 
  # every time the slider is moved
  output$userHist = renderPlot({
    hist(rnorm(input$hist_slider_val))
  })
}

shinyApp(ui, server)

If lots of users have a strong need for this kind of thing, we can look into ways to support non-blocking-even-for-the-current-session abstractions more officially, and safely, than this. Please 👍 this issue or leave a comment below if you are hitting this too.

(P.S.: There should be no need to setwd to the app dir. Shiny does this for you automatically; you can just refer to stuff in your app dir using relative paths.)

[raphaelvannson]

Hello @jcheng5,

Many thanks for your quick and crystal clear response!

I read most of the doc but I conceal I did skim-read the flush-cycle section thinking it was explaining some details I may not need.
May I suggest to make it very explicit what the package can and cannot do in the vignette explaining how this works with Shiny apps?

I agree there are 2 separate use cases:

1 - Submit and forget:

• What you called "fire and forget",
• The async process never returns a value back to the parent process
• The async process terminates on its own when the processing is completed
• The parent process can die during the async processing.
• This would be used when users submit a very long job and they are not expected to keep the browser / user session open until the async process completes (they will retrieve the results of the async process via some other way later).

2 - Submit and retrieve:

• The parent process retrieves the value returned by the async process and terminates the async process.
• The parent process must remain alive until the async process has returned.
• If the parent dies while the async process is running, then the async process must terminate on its own or be terminated to avoid a process/resource leak.
• This would be used when users submit relatively short jobs (seconds to minutes) and are expected to keep their their session open (the parent process is kept alive). This would avoid blocking the UI while the "short" job is running.

So far my strategy for "Submit and forget" is to invoke a R script in a separate process with a system call, example:

system("Rscript /path/to/script.R arg1 arg2 ...", wait = FALSE)

This does exactly what I am looking for since the async process will terminate on its own when it has completed processing.
The script updates some kind of database or writes to some logs to allow to track its status.
tryCatch() can be used in the script to manage errors (and update the status via the db or logs to let us know it failed).

Thanks again!
Raphael

[raphaelvannson]

@jcheng5

You can also see the same question on Stackoverflow at https://stackoverflow.com/questions/50165443/async-process-blocking-r-shiny-app

Feel free to keep an eye on the up-votes there as well.

Thanks!
Raphael

[jcheng5]

@raphaelvannson I'd add just one more thing to your very useful reply. Instead of calling system() directly for "submit and forget", you might consider using callr::r_bg(..., supervise = FALSE). I haven't used this approach myself, but it should work and I think it is likely easier to pass parameters this way (without worrying about manually escaping, serializing, etc.). And this way you at least have the option to retrieve the result from the parent process if you want to.

(callr doesn't yet integrate with promises automatically but I suspect we'll do that sooner rather than later--it should be very straightforward.)

[raphaelvannson]

Hello @jcheng5,

Thanks a lot for the suggestion - I came across callr in my research but only skim-read it since I already a solution for "fire and forget" and it didn't seem to support "fire and retrieve".
But the prospect of not having to serialize / escape arguments sounds interesting. I'll have another look, thanks again!

[vnijs]

Great discussion. Thanks for starting it @raphaelvannson! I was hoping to use promises to execute cross-validation (i.e., run the CV in a separate process and return the result when done). However, I was hoping the user would then be able to do 'other things' while the CV was running.

Seems like callr::r_bg might be what I should try first. Any idea if it would be possible for the user to terminate that process? If you have any examples you could point to, that would be great. Else, I can post back when I have one.

[vnijs]

FYI https://github.com/HenrikBengtsson/future.callr

[dgyurko]

Hi, @jcheng5

I gave a lightning talk about async Shiny at eRum 2018. After my talk, all the questions were about allowing intra-session responsiveness, so it's definitely a feature useR-s are looking for.

Thanks for the great work!

[jcheng5]

OK, thanks for the feedback @dgyurko!

[ismirsehregal]

Hi,
Just to give some more feedback:
I was also trying to increase intra-session responsiveness via the promises / future package for some hours before I stumbled over this issue.
Now I’m trying to utilize @jcheng5 proposal: callr::r_bg(..., supervise = FALSE)

Here is a working example (hopefully helping others searching for a similar solution), which in my eyes seems to be a little bumpy (I’m far away from being a shiny expert..). Maybe someone has ideas to realize the same behavior but in a more elegant way?
Best regards

suppressPackageStartupMessages(library("data.table"))
suppressPackageStartupMessages(library("shiny"))
suppressPackageStartupMessages(library("DT"))
suppressPackageStartupMessages(library("callr"))

ChildProcess <- function() {
  rx <- r_bg(function() {
    # long running query
    Sys.sleep(5)
    DT <- data.table::data.table(A = Sys.time(), B = runif(10, 5.0, 7.5), C = runif(10, 5.0, 7.5))
    ResultList <- list(DT=DT, QueryTime=Sys.time())
    return(ResultList)
  }, supervise = TRUE)
  
  return(rx)
}


ui <- fluidPage(
  textInput("RandomNumber", "Random output", value = "3.1415"),
  div(dataTableOutput("Table"), tags$style(type="text/css", ".recalculating {opacity: 1.0;}"))
)

server <- function(input, output, session) {
  
  observe({
    invalidateLater(100)
    updateTextInput(session, "RandomNumber", value = as.character(runif(1, 5.0, 7.5)))
  })
  
  Display <- reactiveValues(table = NULL)
  
  GetData <- reactive({
    Display$table
    print("PID:")
    print(ChildProcess()$get_pid())
    return(ChildProcess())
  })
  
  DbTables <-
    reactivePoll(
      intervalMillis = 100,
      session,
      checkFunc = function() {
        GetData()$is_alive()
      },
      valueFunc = function() {
        if (!GetData()$is_alive()) {
          GetData()$get_result()
        } else{
          NULL
        }
      }
    )
  
  observe({
    req(DbTables())
    print("Result:")
    print(DbTables())
    if (!is.null(DbTables())) {
      Display$table <- DbTables()
    }
    
  })
  
  output$Table <- DT::renderDataTable({
    req(Display$table) # will render only for new data in table
    datatable(Display$table[["DT"]], caption = paste("Last update:", as.character(Display$table[["QueryTime"]])))
  })
  
}

shinyApp(ui = ui, server = server)

[tylermorganwall]

I developed a solution to this in my package, skpr, when I was implementing progress bars that would work with async shiny. The main downside is having to serialize and de-serialize the output of the future yourself, but it does free up the main Shiny loop. The user can interact with the local R session while the computation continues.

The solution involves an observer checking for the existence of a per-session unique file (generated at the beginning of the session). When the future is called, rather than returning the object itself, it ends in a saveRDS call with the per-session filename generated at the beginning of the session. The future object is only used to determine if the future has resolved--it carries no data. The observer checks for the existence of the unique file and that the future has been resolved: when those conditions are met, it loads the value into a reactiveVal. The reactive value is the one that goes to the outputs.

I avoid race conditions by disabling input buttons with shinyjs until the future is resolved. I could also do this by ignoring the inputs while the future is not resolved (with the resolved() function). With the progress bar, the user is also aware that computation is ongoing--so they aren't under the impression that the application has stalled.

I'm not a Shiny expert, but this solution seems to work pretty well when I'm testing with multiple sessions locally.

[ismirsehregal]

@tylermorganwall thanks for your input!

It’s been a while but now I’m coming back to this.

I tried to apply your suggestions to my earlier example – and would be glad to get some feedback if I got you right or did something wrong:

suppressPackageStartupMessages(library("shiny"))
suppressPackageStartupMessages(library("promises"))
suppressPackageStartupMessages(library("future"))
suppressPackageStartupMessages(library("data.table"))
suppressPackageStartupMessages(library("DT"))

plan(multiprocess)

ui <- fluidPage(
  textInput("RandomNumber", "Random output", value = NULL),
  div(
    dataTableOutput("Table"),
    tags$style(type = "text/css", ".recalculating {opacity: 1.0;}")
  )
)

server <- function(input, output, session) {
  
  sessionUniqueFileName <- paste0(session$token, ".rds")
  print(file.path(getwd(), sessionUniqueFileName))
  
  session$onSessionEnded(function() {
    if (file.exists(sessionUniqueFileName)) {
      file.remove(sessionUniqueFileName)
    }
  })
  
  observe({
    # fast running code
    invalidateLater(100)
    updateTextInput(session, "RandomNumber", value = as.character(runif(1, 5.0, 7.5)))
  })
  
  reactivePromise <- reactive({
    sleepTime <- 5
    promise <- future({
      # long running code
      QueryTime = Sys.time()
      Sys.sleep(sleepTime)
      DT <- data.table::data.table(
          A = QueryTime,
          B = runif(10, 5.0, 7.5),
          C = runif(10, 5.0, 7.5)
        )
      ResultList <- list(DT = DT, QueryTime = QueryTime)
      saveRDS(ResultList, file = sessionUniqueFileName)
    })
    invalidateLater(sleepTime*2000)
    return(promise)
  })
  
  tableData <-
    reactivePoll(
      intervalMillis = 100,
      session,
      checkFunc = function() {return(resolved(reactivePromise()))},
      valueFunc = function() {
        if (file.exists(sessionUniqueFileName)) {
          return(readRDS(sessionUniqueFileName))
        } else{
          return(NULL)
        }
      }
    )
  
  output$Table <- DT::renderDataTable({
    req(tableData())
    datatable(tableData()[["DT"]], caption = paste("Last update:", as.character(tableData()[["QueryTime"]])))
  })
  
}

shinyApp(ui = ui, server = server)

The approach indeed isn’t blocking the whole app, but it seems to slow down the execution of the “fast” observer (which is not the case using the callr-approach) while the promise isn’t resolved – also among multiple local sessions (have a look at the refreshing-rate of the random number – 5 seconds fast – 5 seconds slow).

[ismirsehregal]

Furthermore, here is a solution avoiding the need to save a file (saveRDS), unfortunately with the same behavior:

suppressPackageStartupMessages(library("shiny"))
suppressPackageStartupMessages(library("promises"))
suppressPackageStartupMessages(library("future"))
suppressPackageStartupMessages(library("data.table"))
suppressPackageStartupMessages(library("DT"))

plan(multiprocess)

ui <- fluidPage(
  textInput("RandomNumber", "Random output", value = NULL),
  div(
    dataTableOutput("Table"),
    tags$style(type = "text/css", ".recalculating {opacity: 1.0;}")
  )
)

server <- function(input, output, session) {
  
  promisedData <- reactiveValues(DT = NULL, QueryTime = NULL)
  
  observe({
    # fast running code
    invalidateLater(100)
    updateTextInput(session, "RandomNumber", value = as.character(runif(1, 5.0, 7.5)))
  })
  
  observe({
    sleepTime <- 5
    promise <- future({
      # long running code
      QueryTime = Sys.time()
      Sys.sleep(sleepTime)
      DT <- data.table::data.table(
          A = QueryTime,
          B = runif(10, 5.0, 7.5),
          C = runif(10, 5.0, 7.5)
        )
      ResultList <- list(DT = DT, QueryTime = QueryTime)
      return(ResultList)
    })

    then(promise, onFulfilled = function(value){
      promisedData$DT <<- value$DT
      promisedData$QueryTime <<- value$QueryTime
      }, onRejected = NULL)
    invalidateLater(sleepTime*2000)
  })
  
  output$Table <- DT::renderDataTable({
    req(promisedData$DT)
    req(promisedData$QueryTime)
    datatable(promisedData$DT, caption = paste("Last update:", as.character(promisedData$DT[["QueryTime"]])))
  })
  
}

shinyApp(ui = ui, server = server)

[ismirsehregal]

@vnijs it seems you weren't advertising your investigation sufficiently (Or I didn' read as careful as I should...).

Adding library("future.callr")
And replacing plan(multiprocess) with plan(callr) in the above code works perfectly! None of the afore mentioned disadvantages remain.
Thanks!

[ColinFay]

Hello,

Just dropping by to support the need for a "non-blocking-even-for-the-current-session".

My use case : I have a page with several graphs, one taking several seconds to compute.

What I'm doing is using the method described in the second comment to this issue, so that users can see graphs n+1even if graph n is not ready.

minimal reprex

Blocking when performing long computation

library(shiny)

ui <- fluidPage(
    column(6, plotOutput("one")),
    column(6, plotOutput("two")),
    column(6, plotOutput("three")),
    column(6, plotOutput("four"))
)

server <- function(input, output, session) {
  output$one <- renderPlot({
    # Simulating long computation
    Sys.sleep(5)
    plot(iris)
  })
  
  output$two <- renderPlot({
    plot(airquality)
  })
  output$three <- renderPlot({
    plot(mtcars)
  })
  output$four <- renderPlot({
    plot(cars)
  })
}

shinyApp(ui, server)

Non blocking

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


ui <- fluidPage(
  column(6, plotOutput("one")),
  column(6, plotOutput("two")),
  column(6, plotOutput("three")),
  column(6, plotOutput("four"))
)

server <- function(input, output, session) {
  
  plotiris <- reactiveVal()
  
  plotiris(NULL)
  
  future({
    Sys.sleep(5)
    iris
  }) %...>%
    plotiris() %...!%
    (function(e){
      plotiris(NULL)
      warning(e)
    })
  
  output$one <- renderPlot({
    req(plotiris())
    plot(plotiris())
  })
  
  output$two <- renderPlot({
    plot(airquality)
  })
  output$three <- renderPlot({
    plot(mtcars)
  })
  output$four <- renderPlot({
    plot(cars)
  })
}

shinyApp(ui, server)

[white942]

I'd like to +1 for a need of intra session async. Many thanks!

[damrine]

Also will add a plug for a need of intra session async.

[stefanoborini]

Excellent sum up of the topic. This post should definitely be part of the documentation.

Just for the record, as a python/React programmer that is just moving into the Shiny/R world, I must say I am quite impressed how far R has gone since the last time I used it, 10 years ago.

[jcubic]

This is really problematic in our application where we want to close the modal call runjs to update the front-end code and later update the backend. It's not possible, because removeModal is executed after promise is resolved. The same behavior is with later package. The code is executed later but runjs and removeModal execute after the laster got executed even if those functions are execute before the async code.

Promises are useless if they are no async in single session, in your application we use docker+swarm and there is always single user per R-process, so other uses of promises as per docs are of no use for us.

[jcubic]

Will check tomorrow at work, maybe something else is happening, one thing though is that I use plan(multicore) I think, maybe that's the problem. Will try to investigate what is happening.

[ismirsehregal]

A insufficient number of workers may also cause the blocking.

[jcheng5]

My example closes the modal immediately even if you do this:

    observeEvent(input$ok, once = TRUE, {
      removeModal()
      Sys.sleep(5)
    })

Is it possible some other reactive logic is happening before your observeEvent even gets started? Maybe add a message() to the beginning of the observeEvent; if that takes a few seconds to get logged, then you could use reactlog or profvis to determine exactly what is getting ahead of the observer in line.

[jcubic]

I have no idea what is happening, prints are executed as they should if I have later::later, the code run quick it ends and later the code is executed, but somehow the event is not sent to the browser, removeModal don't close the modal and runjs don't work until later is executed, the same happen with future::future. It's hard to reproduce because if it work in simple case then something is causing this. I use web sockets for transfer.

[jcubic]

What I've found is that there was message in web socket:

{"modal":{"type":"remove","message":null}}

but the modal was not removed instantly in our application, do you have any why this might happen?

Just before this message there was:

{"busy":"busy"}

Bu it seems that the same happen with simple example.

[jcheng5]

@jcubic Let's take the discussion off of this thread, since it's no longer related to promises. You can email me at joe@rstudio.com.

[pablo-rodr-bio2]

@jcheng5
In the working example you made, you use an observeEvent and put a NULL value at the end of it so the observer doesn't wait until the future is resolved to continue.
What would be the equivalent action to take inside an eventReactive?

[jcheng5]

Hi @pablo-rodr-bio2, I'm not sure why you'd do the same for an eventReactive. Like regular reactive, eventReactive should generally not be used for side effects, only for the result value they produce; this is because Shiny will do its best NOT to execute reactive/eventReactive. If this is a new idea for you, please watch these videos: one, two. It's a lot to sit through but this concept will save you a huge amount of frustration in the end.

That said, if you feel like you have a good reason to perform an async task in an eventReactive and then ignore the result, OR if I've misread your intentions altogether, please tell me more about what you're trying to achieve. Thanks!

[pablo-rodr-bio2]

Thanks for the answer!
My user case is that I'm trying to do a long computation in an async process to not stop the shiny app's intrasession, and save its value in a reactive (value or expression), and then caché it. I fire this process with an input$button. I can't bindCache() an observe() by design, so I tried to replicate this schema on an eventReactive, but it's not possible to use the NULL hint on it (it returns NULL) and if let without changes, the app stops until the future is resolved.
I'll try to come up with an example to make it clear later.

[pablo-rodr-bio2]

Sorry for the delay, here is an example with my use case:

1. I have a slow operation whose result I want to store to use later.
2. While this slow operations is going on, I want to inform the user about the progress on it, so I redirect the output from that process to a text file and make Shiny read and print that file while the slow operation is being deal with in a future.
3. Finally, I want this slow operation to be cached, to in the "future", users don't have to wait for the same operation. That's why I want to store this process in an eventReactive and not in an observeEvent

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

slow_operation <- function(){
  for(i in 1:4){
    print(paste0("This is message ", i))
    Sys.sleep(1)
  }
}

ui <- fluidPage(
  column(3,
         actionButton("button", "Run"),
  ),
  column(9,
         textOutput("text"),
         textOutput("text2")
  )
)

server <- function(input, output, session) {
  
  rout <- tempfile("consoleText", fileext = ".txt")
  file.create(rout)
  console.text <- reactiveFileReader(200, session, rout, readLines, warn=F)
  
  fut1 <- eventReactive( input$button, {
    future({
      sink(rout)
      slow_operation()
      sink()
      return(1)
    })
  })
  
  output$text <- renderText({
    console.text()
  })
  
  output$text2 <- renderText({
    fut1()
  })
  
  
}

shinyApp(ui, server)

If I run this, the 4 messages are printed at once when the slow_operation() is finished and not while it's being dealt with in the future.

[ismirsehregal]

A insufficient number of workers may also cause the blocking.

I just wanted to leave a note here, that by now future_promise() is available to address this issue:

https://rstudio.github.io/promises/articles/future_promise.html

[schloerke]

For anyone wanting a work around for downloading files asynchronously without blocking the UI....

(Thank you @andrie for the original approach!)

---

The work around given by #23 (comment) achieves independent async work as Shiny receives a NULL after the async work is started and updates a reactive value when the async work is completed. This work around behavior is not possible with the standard download handler, causing the UI to block as it is waiting for the outputs to flush.

To make a work around, we can use two buttons: a regular button that looks like a download button and a hidden download button that is programmatically clicked.

Processing steps:

• On action button click,
  • Perform async work to create a file path with download contents
  • Shiny receives a NULL and flushes immediately (allowing the UI to be free for interactions)
• When the file path is calculated,
  • Use {shinyjs} to click the hidden download button
• When the download button is click is received,
  • Copy the next downloadable file to the download location
  • Have the browser download the downloadable file

Reprex

library(shiny)
library(promises)
library(rlang)

## ------------------------------------------

#' Create a download button for independent, asynchronous file downloads
#'
#' Use these functions to create two buttons to facilitate downloading a file. A
#' regular button will be clicked by the user, and the invisible download button
#' will be clicked programmatically.
#'
#' The filename and contents are specified by the corresponding
#' [async_download_server()] defined in the server function.
#'
#' @inheritParams shiny::downloadButton
async_download_button <- function(outputId, label = "Download", class = NULL, ..., icon = shiny::icon("download")) {
  tagList(
    # Enable shinyjs
    shinyjs::useShinyjs(),
    # Add regular button to trigger async calculations
    actionButton(inputId = paste0(outputId, "_btn"), label = label, class = class, icon = icon, ...),
    # Add invisible download button to be clicked by `shinyjs::click()`
    downloadButton(outputId = outputId, class = "invisible")
  )
}


#' Serverside handling of independent, asynchronous file downloads
#'
#' This method is different from the standard [downloadHandler()] in that
#' `content(file)` is replaced with an `expr` that should return a file path
#' containing the file to be downloaded. When the user clicks the corresponding
#' UI button, the `expr` is evaluated. However, `{shiny}` will not wait for the
#' execution to finish. Once finished, the UI button is clicked
#' programmatically, which will trigger the download. This allows for
#' long-running calculations to be performed without blocking up the UI.
#'
#' Allows content from the Shiny application to be made available to the user as
#' file downloads (for example, downloading the currently visible data as a CSV
#' file). Both filename and contents can be calculated dynamically at the time
#' the user initiates the download. Assign the return value to a slot on
#' `output` in your server function, and in the UI use
#' [downloadButton()] or [downloadLink()] to make the
#' download available.
#'
#' @inheritParams shiny::downloadHandler
#' @param outputId The ID of the download button used in the UI. To avoid
#'        non-hacky code, this must be supplied.
#' @param expr An expression that returns a file path containing the file to be
#'        downloaded
#' @param filename Function that receives the file path returned from `expr` and
#'        returns the file name to be used for the downloaded file.
#' @param session The Shiny session to utilize.
async_download_server <- function(
  outputId,
  expr,
  filename,
  ..., # Ignored
  contentType = NULL,
  outputArgs = list(),
  session = getDefaultReactiveDomain()
) {
  stopifnot(is.function(filename))
  stopifnot(length(formals(filename)) == 1)

  input <- session$input
  output <- session$output

  btn_name <- paste0(outputId, "_btn")
  btn_download_name <- outputId

  # Capture user's expression
  func <- quoToFunction(rlang::enquo0(expr))
  downloaded_file_name <- fastmap::fastqueue()

  observeEvent(
    # Listen for regular button to be clicked
    input[[btn_name]],
    {
      # Return location where file is stored
      func() %...>%
        {
          file <- .

          # Add the file name to the download queue
          downloaded_file_name$add(file)

          # Click _real_ download button
          # message("clicking button")
          shinyjs::click(btn_download_name)
        }

      # Hide the async operation from Shiny by not having the promise be
      # the last expression.
      NULL
    }
  )

  # Listen for the `shinyjs::click()` event
  # Copy the file to the download location
  output[[btn_download_name]] <-
    downloadHandler(
      filename = function() {
        filename(downloaded_file_name$peek())
      },
      content = function(file) {
        # Copy file from temp location to download location
        file.rename(downloaded_file_name$peek(), file)
        # Remove first file from download queue
        downloaded_file_name$remove()
      }
    )
}


## ------------------------------------------


# Set up future plan
future::plan("multisession")
# Set up fake data
histdata <- rnorm(500)


ui <- fluidPage(
  shinyjs::useShinyjs(),
  plotOutput("plot1", height = 250),
  sliderInput("slider", "Number of observations:", 1, 100, 50),
  downloadButton("download", "Download"),
  async_download_button("async_dwn", label = "Async Download"),
  tags$br(),tags$br(),
  "Counter: ", verbatimTextOutput("counter"),
  tags$br(),tags$br(),
  "Notes:", tags$br(),
  tags$ul(
    tags$li("The 'Download' button will block the UI until the download is complete"),
    tags$li("The 'Async Download' button will not block the UI interactions")
  )
)



server <- function(input, output) {

  # Have counter constantly updating on the UI.
  # This is like user interactions (but without the user)
  counter_val <- reactiveVal(0)
  output$counter <- renderText({ counter_val() })

  update_counter <- function() {
    delay <- 1/4
    if (isolate(counter_val()) > (2 * 60 / delay)) {
      isolate(counter_val("(counter stopped)"))
      return()
    }
    isolate(counter_val(counter_val() + 1))
    # Update again after `delay` seconds
    later::later(update_counter, delay)
  }
  update_counter()


  data <- reactive({ histdata[1:input$slider] })
  output$plot1 <- renderPlot({ hist(data()) })


  # Simpler code
  # Blocks UI
  output$download <- downloadHandler(
    filename = function() {
      "download_data.txt"
    },
    content = function(file) {
      # Capture all shiny values before sending to `future_promise()`
      dt <- data()
      future_promise({
        # Fake processing time
        Sys.sleep(5)

        write.table(dt, file = file, row.names = FALSE, col.names = FALSE)
      })
    }
  )


  # Must supply output name as parameter
  # Must supply expression to create a file path
  # Does not block the UI
  async_download_server(
    "async_dwn",
    {
      # Capture all shiny values before sending to `future_promise()`
      dt <- data()

      future_promise({
        # Fake processing time
        Sys.sleep(5)

        tmpfile <- tempfile(fileext = ".txt")
        write.table(dt, file = tmpfile, row.names = FALSE, col.names = FALSE)

        # Return location where file is stored
        tmpfile
      })
    },
    filename = function(file) {
      # For fun... count the number of lines in the file
      paste0("demo_hist_data_", R.utils::countLines(file), ".txt")
    }
  )
}

shinyApp(ui, server)

[king-of-poppk]

In response to #23 (comment):

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.

Use incremental ids! Or whatever can help decide who was scheduled last.

Or if you reference input values in promise handlers, they might pick up values that were set after the submit button was clicked!

Don't do that.

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

You can somewhat mitigate this by forcing the .recalculating class on corresponding output

...
if (isCalculating()) {
  currentOutput <- getCurrentOutputInfo(session = session)
  later(\() {
    # NOTE This notifies that the current output is being recalculated.
    # NB: We have to delay this because Shiny will consider the output
    # to be calculated once we reach req below.
    session$showProgress(currentOutput$name)
  })
  req(FALSE, cancelOutput = TRUE)
}
...

and tweaking the CSS to reduce the flickering

.shiny-bound-output:not(.recalculating) {
  transition: opacity 250ms ease 50ms;
}

Ideally one would get rid of the contradictory WebSocket messages sent by the blocking implementation.

[ismirsehregal]

For those interested: As of shiny 1.8.1 the R6 class "ExtendedTask" was added:

[...] a new simple way to launch long-running asynchronous tasks that are truly non-blocking. That is, even within a session [...]

[jcheng5]

@ismirsehregal Thanks for noticing! The ExtendedTask feature was written with this issue in mind. I’m wrapping up writing the docs and examples for it now.

[jcheng5]

This feature is now supported in Shiny thanks to ExtendedTask. Thanks for all the enthusiasm!

[raphaelvannson]

Wow! Thank you everyone for your interest and tenacity!!
Long live advanced Shiny apps! 🙂

[king-of-poppk]

This does not implement asynchronous reactives though right? The reactive graph evaluation is still blocked by promises and ExtendedTask does not help.

[gadenbuie]

This does not implement asynchronous reactives though right? The reactive graph evaluation is still blocked by promises and ExtendedTask does not help.

No, ExtendedTask only block the parts of the reactive graph that directly depend on the $result() of the extended task. That leaves the rest of the app still working as expected. Depending on the task and the app, you can generally set it up so that the task doesn't block the normal functioning of the app while the extended task runs.

Here's an app modified from the example in the blog post. Notice that the user can interact with the y input and outputs that use y but don't depend on the extended task can still update while the app is running.

Kapture.2024-04-19.at.09.11.28.mp4

App Code

library(shiny)
library(bslib)
library(future)
library(promises)
future::plan(multisession)

ui <- page_fluid(
  p("The time is ", textOutput("current_time", inline=TRUE)),
  hr(),
  numericInput("x", "x", value = 1),
  numericInput("y", "y", value = 2),
  input_task_button("btn", "Add numbers"),
  textOutput("y_value"),
  textOutput("sum")
)

server <- function(input, output, session) {
  output$current_time <- renderText({
    invalidateLater(1000)
    format(Sys.time(), "%H:%M:%S %p")
  })

  sum_values <- ExtendedTask$new(function(x, y) {
    future_promise({
      Sys.sleep(5)
      x + y
    })
  }) |> bind_task_button("btn")

  observeEvent(input$btn, {
    sum_values$invoke(input$x, input$y)
  })

  output$sum <- renderText({
    sum_values$result()
  })

  output$y_value <- renderText({
    paste("y is", input$y)
  })
}

shinyApp(ui, server)

[king-of-poppk]

OK. How would one leverage this to render plots async, cancelling the previous render if still pending? So that one can tweak inputs to the plot while it is rendering. Note that in your example one cannot press the button to re-run the computation while the previous one is pending.

[king-of-poppk]

See for instance this React example: https://youtu.be/nLF0n9SACd4?t=201.

[gadenbuie]

cancelling the previous render if still pending

Unfortunately, this isn't supported in R at this time with ExtendedTask. It's definitely something that we're considering.

one cannot press the button to re-run the computation while the previous one is pending

This is a key feature (not a bug) of input_task_button(). But you don't need to use input_task_button() to start an extended task. The ExtendedTask class provides a $status() method that returns a reactive whose value is "running" if the task is in progress. Combining this with input debouncing techniques, you can get pretty close to the React example.

[jcheng5]

@king-of-poppk This isn't currently supported in Shiny for R because, to my knowledge, neither future nor mirai have a built-in way to do task cancellation. This issue was all I could find.

In Shiny for Python, it's supported (you just call task.cancel() right before task.invoke()), because Python tasks have a cancel() method.

[king-of-poppk]

@jcheng5 OK. Cancel could be "mocked" as ignoring intermediate pending results for a first implementation. For a second implementation, some future backends support cancellation (via SIGTERM/SIGKILL), others just eventually crash.

[jcheng5]

@king-of-poppk Since you seem to very much know what you're doing, maybe this will help. I hesitated to call attention to it because stop_mirai(mirai_obj) doesn't actually interrupt the mirai, it keeps running. But you can use this pattern to kill futures however you want.

[king-of-poppk]

@jcheng5 Thanks, I'll look into that!