An example to create an async drop-in replacement for eventReactive

app.R

#' An example to create asyncronously evaluated eventReactives.
library(shiny)

#' An async version of eventReactive, using the 'future' package to spawn a seperate process to evaluate the handler expression. 
#' Unlike in usual eventReactive, the handlerExpr cannot have a side-effect on the main application, as it is evaluated in a seperate
#' process.
#' @param eventExpr The expression triggering the handlerExpr. It is evaluated _synchronously_.
#' @param handlerExpr The expression being calculated in async.
#' @return Returns a reactive that can be used in other reactives that depend on the async result
eventReactiveAsync <- function(eventExpr,handlerExpr,event.env = parent.frame(),handler.env=parent.frame(),...) {
  require('future')
  
  asyncVal <- shiny::reactiveVal()
  
  f <- NULL
  
  handlerExpr <- call("isolate",eval(enquote(substitute(handlerExpr))))
  eventExpr <- eval(enquote(substitute(eventExpr)))
  
  force(handler.env)
  
  # spawn the async process
  shiny::observeEvent(
    eventExpr,{
      f <<- future::future(handlerExpr,substitute = FALSE, envir = handler.env,evaluator = future::plan("multiprocess"))
    },
    event.quoted = TRUE,
    event.env = event.env,
    ...
  )
  
  # collect the results when ready
  shiny::observe({
    shiny::invalidateLater(1)
    if ("Future" %in% class(f) & future::resolved(f)) {
      asyncVal(future::value(f))
    }
  })
  
  reactive({
    req(asyncVal());
    asyncVal()
    })
}

ui <- shinyUI(fluidPage(
  
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  
  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      tags$b(style="color: red","Since the (slow) histogram plot depends on an async version of eventReactive, the fast output update is not blocked."),
      tags$br(),
      tags$br(),
      tags$b("Fast output: "), 
      uiOutput("numBins"),
      tags$br(),
      tags$b("Slow output:"),
      plotOutput("distPlot")
    )
  )
))


server <- function(input, output) {
  
  test <- eventReactiveAsync(input$bins,{
    Sys.sleep(5)
    input$bins
  })
  
  output$numBins <- renderText({
    input$bins
    })
  
  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = test() + 1)
    
    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
    
  })
  
}

shinyApp(ui=ui,server=server)