How do I wrap a blocking function into a promise R

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

  })

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)