Update a reactive value in a function

Question

Context

I have a for loop that parallelizes code with future package. I have to write the results to a csv file. To avoid conflict problems and other problems. I segmented the loop into two for loops. The second parallel loop generates results then the first loop writes the results.

What I want

I would like to display the progress of the first loop. I created a reactive variable react_value I use the ShinyQueue function from the ipc package to update the reactive variable inside the function.

The update is not done. I would like to know how can I do this.

Code

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

ftc_parallel <- function(queue){
    start<- Sys.time()
    for(i in 1:5){
        command_set <- vector(mode = "list")
        for(j in 1:3){
            command_set[[j]] <- future({
                Sys.sleep(sample(1:3, size = 1))
                df <- data.frame(
                    Colonne1 = runif(2),
                    Colonne2 = runif(2),
                    Colonne3 = runif(2)
                )
                return(df)
            }, seed = T)

        }
        queue$producer$fireAssignReactive("react_val", i)
        # write in file
        # results <- bind_rows(Filter(Negate(is.null), lapply(command_set, value)))
        # write.table(results, append = T, sep=";")
    }
    end <- Sys.time()
    time <- end - start
    print(time)

}


ui <- fluidPage(titlePanel(""), sidebarLayout( sidebarPanel(), mainPanel(
    actionButton("bouton", "Button")
)))

server <- function(input, output) {

    react_val <- reactiveVal(0)
    queue <- shinyQueue()
    queue$consumer$start(100)

    observe({ print(react_val())})

    observeEvent(input$bouton, {
        ftc_parallel(queue)
    })
}

shinyApp(ui = ui, server = server)

Answer 1

Not sure this is what you want, but it works if you just enclose the outer loop into a future.

I also changed two things:

• the assignment command_set[[j]] <- is done into the future
• the future returns the time difference

library(shiny)
library(ipc)
library(future)
plan(multisession)
library(promises) # to use %...>%

ftc_parallel <- function(queue){
  start <- Sys.time()
  future({
    for(i in 1:5){
      command_set <- vector(mode = "list")
      for(j in 1:3){
        Sys.sleep(sample(1:3, size = 1))
        command_set[[j]] <- data.frame(
          Colonne1 = runif(2),
          Colonne2 = runif(2),
          Colonne3 = runif(2)
        )
      }
      queue$producer$fireAssignReactive("react_val", i)
      # write in file
      # results <- bind_rows(Filter(Negate(is.null), lapply(command_set, value)))
      # write.table(results, append = T, sep=";")
    }
    end <- Sys.time()
    end - start
  }, seed = TRUE) %...>% print()

}


ui <- fluidPage(titlePanel(""), sidebarLayout( sidebarPanel(), mainPanel(
  actionButton("bouton", "Button")
)))

server <- function(input, output) {
  
  react_val <- reactiveVal(0)
  queue <- shinyQueue()
  queue$consumer$start(100)
  
  observe({ print(react_val())})
  
  observeEvent(input$bouton, {
    ftc_parallel(queue)
    NULL
  })
}

shinyApp(ui = ui, server = server)