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

  })

Abiogenetic

Please post a reproducible example which includes the complete ui.R, and server.R so that we can run the App. – Hypogeal

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 – Hypogeal

@Hypogeal 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. – Gesner

Answer 1

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)

Gesner

Interesting. In this case if sixHourFunction takes a variable about of time to execute, we are in danger of race conditions. – Hypogeal

Thank you very much this appears to have resolved the issue. Would it be possible to wrap multiple functions into the single future? – Abiogenetic

Sure thats possible, but when you are calling multiple functions in a single future they will be executed sequentially and not in parallel anymore. – Gesner