Using standard R shiny progress bar in parallel foreach calculations

Question

I am trying to use the standard R shiny progress bar in a parallel foreach loop using the doParallel back-end. However, this results in the following error message:

Warning: Error in {: task 1 failed - "'session' is not a ShinySession object."

Code (minimum working example)

library(shiny)
library(doParallel)

ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch calculation")
)

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

  workers=makeCluster(2)
  registerDoParallel(workers)

  observeEvent(input$go, {
    Runs=c(1:4)
    Test_out=foreach(i=Runs, .combine=cbind, .inorder=TRUE, .packages=c("shiny"),.export=c("session")) %dopar% { 
      pbShiny = shiny::Progress$new()
      pbShiny <- Progress$new(session,min = 0, max = 10)
      on.exit(pbShiny$close())
      test_vec=rep(0,100)

      for(i in 1:10){
        test_vec=test_vec+rnorm(100)
        pbShiny$set(message="Simulating",detail=paste(i),
                  value=i)
        Sys.sleep(0.2)
      }

    }
  })
}

shinyApp(ui = ui, server = server)

The code runs if I run the foreach loop sequentially (using registerDoSEQ()). Does anyone know how to resolve this issue?

---

Overall Goal

• Show progress to user in a parallel foreach loop using the doParallel back-end in shiny
• User should be aware of the number of workers and the progress per worker and or overall progress

---

There is a similar question under the following link, but it didn't get resolved as no working example was provided:

Utilizing parallel foreach for progress bar in R Shiny

Answer 1

The doParallel package is an extension of the parallel package as shown in the documentation here.

https://cran.r-project.org/web/packages/doParallel/doParallel.pdf

Reading the parallel package's documentation we see that it implements 3 different methods to achieve parallelism. Keep in mind R is a single threaded language.

1. A new R session where the parent process communicates with a worker or child process.
2. Via Forking
3. Using OS level facilities

You can find this information here,

https://stat.ethz.ch/R-manual/R-devel/library/parallel/doc/parallel.pdf

A consequence of this is that the child process cannot communicate with the parent process until it completes its computation and returns a value. This is to the best of my knowledge.

Hence, ticking the progress bar within the worker process will not be possible.

Full disclosure, I have not worked with the doParallel package and the documentation with respect to shiny was limited.

---

Alternative solution

There is a similar package however with extensive documentation with respect to shiny. These are the futures and promises and ipc packages. futures and promises enable asynchronous programming while ipc enables interprocess communication. To help us even more it also has an AsyncProgress() function.

Here is an example where we tick two counters synchronously.

Example

library(shiny)
library(future)
library(promises)
library(ipc)

plan(multisession)


ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch calculation")
)

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

  observeEvent(input$go, {

    progress = AsyncProgress$new(message="Complex analysis")

    future({
      for (i in 1:15) {
        progress$inc(1/15)
        Sys.sleep(0.5)
      }

      progress$close()
      return(i)
    })%...>%
      cat(.,"\n")

    Sys.sleep(1)

    progress2 = AsyncProgress$new(message="Complex analysis")

    future({
      for (i in 1:5) {
        progress2$inc(1/5)
        Sys.sleep(0.5)
      }

      progress2$close()

      return(i)
    })%...>%
      cat(.,"\n")

    NULL
  })
}

shinyApp(ui = ui, server = server)

Your code adapted

Here is the code you have written, slightly modified to spin off many asynchronous processes. Any work can be performed in the worker, such as the vector you create and add an rnorm too. (Not shown here)

library(shiny)
library(future)
library(promises)
library(ipc)

plan(multisession)

ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch calculation")
)

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

  observeEvent(input$go, {
    Runs=c(1:4) #define the number of runs
    progress = list() #A list to maintain progress for each run

    for(j in Runs){
      progress[[j]] = AsyncProgress$new(message="Complex analysis")
      future({
        for (i in 1:10) {
          progress[[j]]$inc(1/10)
          Sys.sleep(0.2)
        }
        progress[[j]]$close()
        return(i)
    })%...>%
        cat(.,'\n')
    }

    NULL
  })
}

shinyApp(ui = ui, server = server)

The code above is a modified version of the code found in the ipc documentation here:

http://htmlpreview.github.io/?https://github.com/fellstat/ipc/blob/master/inst/doc/shinymp.html

Additional Resources:

https://rstudio.github.io/promises/articles/overview.html

Answer 2

I think I found a solution for cases where the number of runs exceeds the number of cores.

I searched for nested future processes and found the following page:

https://cran.r-project.org/web/packages/future/vignettes/future-3-topologies.html

I changed my code as follows. This runs the jobs sequentially per core and updates the respective progress bars accordingly.

library(shiny)
library(future)
library(promises)
library(ipc)
library(listenv)

plan(list(multiprocess, sequential))

ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch calculation")
)

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

  observeEvent(input$go, {
    x <- listenv()
    Runs=12 #define the number of runs
    N=availableCores()
    Tasks=rep(0,N) #Number of sequential tasks per core
    Tasks[1:(Runs-(ceiling(Runs/N)-1)*N)]=ceiling(Runs/N)
    if((Runs-(ceiling(Runs/N)-1)*N)<N){
      Tasks[(Runs-(ceiling(Runs/N)-1)*N+1):N]=ceiling(Runs/N)-1
    }

    progress = list() #A list to maintain progress for each run

    for(j in 1:N){

      for(l in 1:Tasks[j]){
        progress[[(l-1)*N+j]] = AsyncProgress$new(message=paste("Complex analysis, core ",j," , task ",l))
      }

    x[[j]]%<-%{
      for(l in 1:Tasks[j]){
        for (i in 1:10) {
          progress[[(l-1)*N+j]]$inc(1/10)
          Sys.sleep(0.5)
        }
        progress[[(l-1)*N+j]]$close()
      }
    }
    }

    NULL
  })
}

shinyApp(ui = ui, server = server)