Parallel processes in Shiny R (future, promises)

Question

I have problem with understanding how parallel processes in Shiny works. I created simple Shiny app with 2 processes:

1. first is waiting 10s (Sys.sleep(20))
2. second generate random heatmap both are triggered by actionButtons. The idea of the application is to test the asynchrony of processes, i.e. I run process 1, and during it generates a heatmap using the process 2.

Where is the problem? Well, the application works as expected when the button that starts the process 2 is in the observeEvent, which observes the button responsible for starting the process 1 (code lines 49-51). However, if I define this button outside of observeEvent, asynchrony doesn't work and process 1 will be executed first, and then the generated heatmap will appear.

Can someone explain to me why it works like this? Maybe I have a mistake somewhere? I am inclined to do so, because otherwise the necessity defined as I described in the first case makes this functionality very troublesome with more complex applications with many processes. I have R version 4.0.3

library(shiny)
library(promises)
library(future)
library(DT)
library(plotly)
library(chron)

plan(multisession)

testAsyncProcess <- function(x){
  start <- Sys.time()
  Sys.sleep(x)
  end <- Sys.time()
  result <- data.frame(
    start = as.character(times(strftime(start,"%H:%M:%S"))),
    end   = as.character(times(strftime(end,  "%H:%M:%S"))),
    duration = round(end - start,1)
  )
  return(result)
}

ui <- fluidPage(
  titlePanel("async test app"),
  sidebarLayout(
    sidebarPanel(width = 12,
      fluidRow(
        column(3, uiOutput("SimulateAsyncProcesses"), style = 'margin-top:25px'),
        column(4, DTOutput("ProcessInfo"))
      )
    ),
    mainPanel(width = 12,
      fluidRow(
        column(2, uiOutput("GenerateDataToPlot")),
        column(8, offset = 1, plotlyOutput("GeneratedHeatMap"))
      )
    )
  )
)

server <- function(input, output, session) {
  processInfo <- reactiveVal()
  
  DataToPlot <- eventReactive(input$GenerateDataToPlot, {
    matrix(runif(100), nrow = 10, ncol = 10)
  })
  observeEvent(input$SimulateAsyncProcesses, {
    future_promise({testAsyncProcess(10)}) %...>% processInfo()
    
    output$GenerateDataToPlot <- renderUI({
      actionButton("GenerateDataToPlot", "Generate data to plot")
    })
  })
  output$SimulateAsyncProcesses <- renderUI({
    actionButton("SimulateAsyncProcesses", "Simulate async processes")
  })
  output$ProcessInfo            <- renderDT({
    req(processInfo())
    datatable(processInfo(), rownames = FALSE, options = list(dom = 't'))
  })
  output$GenerateDataToPlot     <- renderUI({
    #actionButton("GenerateDataToPlot", "Generate data to plot")
  })
  output$GeneratedHeatMap       <- renderPlotly({
    req(DataToPlot())
    plot_ly(z = DataToPlot(), type = "heatmap")
  })
}

shinyApp(ui = ui, server = server)

Answer 1

I found a way but I am unable to explain. I'm very new to promises.

library(shiny)
library(promises)
library(future)
library(DT)
library(plotly)
library(chron)

plan(multisession)

testAsyncProcess <- function(x){
  start <- Sys.time()
  Sys.sleep(x)
  end <- Sys.time()
  result <- data.frame(
    start = as.character(times(strftime(start,"%H:%M:%S"))),
    end   = as.character(times(strftime(end,  "%H:%M:%S"))),
    duration = round(end - start,1)
  )
  return(result)
}

ui <- fluidPage(
  titlePanel("async test app"),
  sidebarLayout(
    sidebarPanel(
      width = 12,
      fluidRow(
        column(
          3, 
          actionButton("SimulateAsyncProcesses", "Simulate async processes"), 
          style = 'margin-top:25px'
        ),
        column(
          4, 
          DTOutput("ProcessInfo")
        )
      )
    ),
    mainPanel(
      width = 12,
      fluidRow(
        column(
          2, 
          actionButton("GenerateDataToPlot", "Generate data to plot")
        ),
        column(8, offset = 1, plotlyOutput("GeneratedHeatMap"))
      )
    )
  )
)

server <- function(input, output, session) {
  
  
  DataToPlot <- eventReactive(input$GenerateDataToPlot, {
    matrix(runif(100), nrow = 10, ncol = 10)
  })

  processInfo <- reactiveVal()
  
  processInfo2 <- eventReactive(input$SimulateAsyncProcesses, {
    future_promise(testAsyncProcess(10)) %...>% {processInfo(.)}
  })
  
  output$ProcessInfo            <- renderDT({
    req(processInfo2())
    datatable(processInfo(), rownames = FALSE, options = list(dom = 't'))
  })

  output$GeneratedHeatMap       <- renderPlotly({
    req(DataToPlot())
    plot_ly(z = DataToPlot(), type = "heatmap")
  })
}

shinyApp(ui = ui, server = server)