rshinyr-futurer-promises

Parallel processes in Shiny R (future, promises)


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)

Solution

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