How do I wrap a blocking function into a promise RShiny

Question

I have an R Shiny dashboard that has 2 observers that are set to refresh at specific times, One observer refreshes every 6 hours, the other every 2 mins. Both observers run a function that returns a reactive value. This works fine, however every 6 hours when the first observer is triggered it locks the dashboard and prevents the other observer from functioning. After some reading I know that I need to use futures and promises but am unable to implement anything that works as intended. How do I wrap the functions in each observer into respective futures that would prevent blocking?

  values <- reactiveValues()



  observe({

    # Re-execute this reactive expression every 2 mins

    invalidateLater(120000, session)

    values$twominresult <-  twoMinFunction()

  })


  observe({

    # Re-execute this reactive expression every 6 hours

    invalidateLater(21600000, session)

    values$sixhourresult <- sixhourfunction()

  })

Please post a reproducible example which includes the complete ui.R, and server.R so that we can run the App. — Sada93
Using futures and promises will not solve the issue because of the inherent flush cycle in shiny. So if sixhourfunction() is a long-running function. it will block all other observers in this particular session even if you use futures. The only time this is useful is for multiple sessions running in parallel. rstudio.github.io/promises/articles/shiny.html — Sada93
@Sada93 there is a way to create intra-session non-blocking futures. Please see this. However, it has to be taken with a grain of salt: if this approach is used carelessly, it might result in race condition. — ismirsehregal

ismirsehregal ismirsehregal · Accepted Answer · 2019-09-09T12:42:33

Here is an example for intra-session non-blocking futures based on your code snippets:

library(shiny)
library(promises)
library(future)
plan(multiprocess)

twoMinFunction <- function(){
  return(Sys.time())
}

sixHourFunction <- function(){
  Sys.sleep(3)
  return(Sys.time())
}


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

  values <- reactiveValues(twominresult = NULL, sixhourresult = NULL)

  observe({
    # Re-execute this reactive expression every 2 seconds # mins
    invalidateLater(2000, session) # 120000

    myTwoMinFuture <- future({
      twoMinFunction()
    })

    then(myTwoMinFuture, onFulfilled = function(value) {
      values$twominresult <- value
    },
    onRejected = NULL)

    return(NULL)
  })


  observe({
    # Re-execute this reactive expression every 6 seconds # hours
    invalidateLater(6000, session) # 21600000

    mySixHourFuture <- future({
      sixHourFunction()
    })

    then(mySixHourFuture, onFulfilled = function(value) {
      values$sixhourresult <- value
    },
    onRejected = NULL)

    return(NULL)
  })

  output$twominout <- renderText({
    paste("two min result:", values$twominresult)
  })

  output$sixhoursout <- renderText({
    paste("six hour result:", values$sixhourresult)
  })

}

ui <- fluidPage(textOutput("twominout"),
                textOutput("sixhoursout"))

shinyApp(ui, server)

I made it a little faster, so you can see the changes.

Please note the return(NULL) in the observeEvent() - this is hiding the future from its own session - allowing intra-session responsiveness. Please keep in mind that this pattern may cause race conditions if used the wrong way (Please see Joe Cheng's comment, which I already mentioned above)

How do I wrap a blocking function into a promise RShiny

1 Answers