Continue to interact when there is a long calculate

Question

I have code that is taking a long time to execute and I would like to know if there is a way to continue interacting with other elements of the application?

When you press the "go" button, a long calculation is run. I have another button "+", when it pressed increments a value which is displayed in a text field

app_server <- function(input, output, session) {

  observeEvent(input$go, {

      num_cores <- detectCores(); cl <- makeCluster(num_cores); registerDoParallel(cl)

      l <- as.list(as.character(1:10)); groups <- as.integer(gl(length(l), 3, length(l))); chunk <- split(l, groups)
    
      output$plot <- renderPlot({
        withProgress(message = 'Calculation in progress',
                     detail = 'This may take a while...', value = 0, {
                       for (i in 1:length(chunk)) {
                         subl <- chunk[[i]]
                         res <- foreach(j = 1:length(subl), .combine = 'rbind',
                                        .packages = c("dplyr", "caret")) %dopar% {
                                          return(data.frame("index" = (i-1)*3 + j))}
                         print(res)
                         incProgress(1/length(l))
                         Sys.sleep(0.5)
                       }
                       env <- foreach:::.foreachGlobals; rm(list=ls(name=env), pos=env); stopCluster(cl)
                     })
        plot(cars)
      })
    })

  values <- reactiveValues(counter = 0); 
  observeEvent(input$inc, { values$counter <- values$counter + 1 })
  output$value <- renderText({ values$counter })

}

app_ui <- function(request) { actionButton("go", "Go"), plotOutput("plot"), actionButton("inc", "+"), textOutput("value"))}

---

Answer 1

If you have a long process, put it in a function:

longProcess <- function(x) {
  a time-consuming process depending on x
}

Then you can run this process asynchronously in a Shiny app with the help of the callr package:

library(shiny)
library(callr)

longProcess <- function(x) {
  a time-consuming process depending on x
}

app_server <- function(input, output, session) {
  
  PromisedResult <- eventReactive(input$go, {
    callr::r_bg(
      longProcess, args = list(x = ......)
    )
  })
  
  ProcessDone <- reactive({
    if(PromisedResult()$is_alive()) {
      invalidateLater(millis = 1000, session = session)
      NULL
    } else {
      TRUE
    }
  })
  
  output$plot <- renderPlot({
    req(ProcessDone())
    result <- PromisedResult()$get_result()
    plot(something depending on result)
  })
  
  values <- reactiveValues(counter = 0); 
  observeEvent(input$inc, { values$counter <- values$counter + 1 })
  output$value <- renderText({ values$counter })
  
}

I don't know yet how to have a progress bar. Let me think about that.

---

EDIT: progress bar

To have a progress bar, you have to use a different technique. Namely, you have to perform the long process in a future, and use the ipc package to have a progress bar.

library(shiny)
library(ipc)
library(future)
library(promises)
plan(multisession)

ui <- fluidPage(
  
  titlePanel("Countdown"),
  
  sidebarLayout(
    sidebarPanel(
      actionButton('run', 'Run'),
      actionButton("inc", "Increment")
    ),
    
    mainPanel(
      textOutput("value"),
      plotOutput("result")
    )
  )
)

server <- function(input, output) {
  
  # A reactive value to hold output
  result_val <- reactiveVal()
  
  # Handle button click
  observeEvent(input$run,{
    result_val(NULL)
    
    # Create a progress bar
    progress <- AsyncProgress$new(message = "Complex analysis")
    future({
      for(i in 1:10){
        Sys.sleep(1)
        progress$inc(1/10) # Increment progress bar
      }
      progress$close() # Close the progress bar
      1:10 # result
    }) %...>% result_val  # Assign result of future to result_val
    
    # Return something other than the future so we don't block the UI
    NULL
  })
  
  # Set output to reactive value
  output$result <- renderPlot({
    req(result_val())
    plot(result_val(), result_val())
  })
  
  # the 'increment' button - will work during the long process
  values <- reactiveValues(counter = 0); 
  observeEvent(input$inc, { values$counter <- values$counter + 1 })
  output$value <- renderText({ values$counter })
  
}

# Run the application
shinyApp(ui = ui, server = server)