How can I make UI respond to reactive values in for loop?

Question

I'm making a shiny app which reads from a file, does some processing, and produces a table in the UI. The problem is that the file may be very big, and the analysis is slow, so processing the table may take a long time (often several minutes, possibly half an hour). I would like to display a partial table, and add to it every time a new row has been computed so that the user can see the data as it is generated.

I'm using a reactive value to store the data to make the table, and then rendering the table using renderTable()

below is an illustration of the problem (it's not my actual code for cleanliness reasons, but it works as an illustration)

library(shiny)

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "button", label = "make table")
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

makeTable <- function(rv){
  data = c(1:10)
  withProgress({
    for(i in 1:5){
      d = runif(10)
      data = rbind(data, d)
      Sys.sleep(1)
      rv$table = data
      incProgress(1/5)
    }
  })
  rv$table = data
}

server <- function(input, output){
  rv = reactiveValues(table = c())

  observeEvent(input$button, {
    makeTable(rv)
  })

  output$table = renderTable(
    rv$table
  )
}

shinyApp(ui, server)

I put sys.sleep(1) so that the table is built over 5 seconds. Currently, despite rv$data = data appearing inside the for loop, the table is not shown until the whole thing is finished. Is there a way to modify the code above so that the rows of the table (generated by each iteration of the for loop) are added each second, rather then all at the end?

Edit: I should have made it clear that the file is read in quickly (before the make table button is pressed), the long part is the processing inside the for loop (which depends on the size of the file). I'm not having trouble reading from or writing to files - I'm wondering if there's a way to assign rv$table = data inside the for loop, and have that change reflected in the UI while the loop is still running (and in general, how to make any arbitrary UI and reactive value in a loop behave that way)

Answer 1

You need asynchronous capabilities. This is built in shiny since v1.1+.

The promises package (which already comes with shiny) offers a simple API to run asynchronous operations in shiny and is designed to play well with reactives.

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

EDIT: Code adapted from @ismirsehregal, refactored and now using futures to handle the parallel processing and async results.

library(shiny)
library(future)
plan(multiprocess)

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "button", label = "make table")
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

makeTable <- function(nrow){
  filename <- tempfile()
  file.create(filename)
  future({
    for (i in 1:nrow) {
        # expensive operation here
        Sys.sleep(1)
        matrix(c(i, runif(10)), nrow = 1) %>%
        as.data.frame() %>%
        readr::write_csv(path = filename, append = TRUE)
    }
  })

  reactiveFileReader(intervalMillis = 100, session = NULL,
                     filePath = filename,
                     readFunc = readr::read_csv, col_names = FALSE)
}

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

  table_reader <- eventReactive(input$button, makeTable(10))
  output$table = renderTable(table_reader()()) # nested reactives, double ()
}

shinyApp(ui, server)

Answer 2

I would detach the processing part from your shiny app, to keep it responsive (R is single threaded).

Here is an example which continuously writes to a file in a background R process created via library(callr). You can then read in the current state of the file via reactiveFileReader.

Edit: if you want to start the file processing session-wise just place the r_bg() call inside the server function (see my comment). Furthermore, the processing currently is done row-wise. In your actual code you should consider processing the data batch-wise instead (n rows, what ever is reasonable for your code)

library(shiny)
library(callr)

processFile <- function(){

  filename <- "output.txt"

  if(!file.exists(filename)){
    file.create(filename)
  }

  for(i in 1:24){
    d = runif(1)
    Sys.sleep(.5)
    write.table(d, file = filename, append = TRUE, row.names = FALSE, col.names = FALSE)
  }

  return(NULL)
}


# start background R session ----------------------------------------------
rx <- r_bg(processFile)


# create shiny app --------------------------------------------------------

ui <- fluidPage(
  titlePanel("reactiveFileReader"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

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

  # rx <- r_bg(processFile) # if you want to start the file processing session-wise

  readOutput <- function(file){
    if(file.exists(file)){
      tableData <- tryCatch({read.table(file)}, error=function(e){e}) 
      if (inherits(tableData, 'error')){
        tableData = NULL
      } else {
        tableData
      }
    } else {
      tableData = NULL
    }
  }

  rv <- reactiveFileReader(intervalMillis = 100, session, filePath = "output.txt", readFunc = readOutput)

  output$table = renderTable({
    rv()
  })

  session$onSessionEnded(function() {
    file.remove("output.txt")
  })

}

shinyApp(ui, server)

As an alternative approach I'd recommend library(ipc) which lets you set up continuous communication between R processes. Also check my answer here on async progressbars.

Result using library(callr):

---

Result using library(promises): (code by @antoine-sac) - blocked shiny session

---

---

Edit: Here is another approach utilizing library(ipc) This avoids using reactiveFileReader and therefore no file handling is required in the code:

library(shiny)
library(ipc)
library(future)
library(data.table)
plan(multiprocess)

ui <- fluidPage(

  titlePanel("Inter-Process Communication"),

  sidebarLayout(
    sidebarPanel(
      textOutput("random_out"),
      p(),
      actionButton('run', 'Start processing')
    ),

    mainPanel(
      tableOutput("result")
    )
  )
)

server <- function(input, output) {

  queue <- shinyQueue()
  queue$consumer$start(100)

  result_row <- reactiveVal()

  observeEvent(input$run,{
    future({
      for(i in 1:10){
        Sys.sleep(1)
        result <- data.table(t(runif(10, 1, 10)))
        queue$producer$fireAssignReactive("result_row", result)
      }
    })

    NULL
  })

  resultDT <- reactiveVal(value = data.table(NULL))

  observeEvent(result_row(), {
    resultDT(rbindlist(list(resultDT(), result_row())))
  })

  random <- reactive({
    invalidateLater(200)
    runif(1)
  })

  output$random_out <- renderText({
    paste("Something running in parallel", random())
  })

  output$result <- renderTable({
    req(resultDT())
  })
}

shinyApp(ui = ui, server = server)

---

To clean up the discussion I've had with @antoine-sac for future readers: On my machine using his code I was indeed experiencing a direct interconnection between the long running code (sleep time) and the blocked UI:

However, the reason for this was not that forking is more expensive depending on the OS or using docker as @antoine-sac stated - the problem was a lack of available workers. As stated in ?multiprocess:

workers: A positive numeric scalar or a function specifying the maximum number of parallel futures that can be active at the same time before blocking.

The default is determined via availableCores() - although on a windows machine plan(multiprocess) defaults to multisession evaluation.

Accordingly the discussion was triggered by a lack of configuration and different defaults used due to the underlying hardware.

Here is the code to reproduce the gif (based on @antoine-sac's first contribution):

library(shiny)
library(future)
library(promises)
plan(multiprocess)
# plan(multiprocess(workers = 10))

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      p(textOutput("random")),
      p(numericInput("sleep", "Sleep time", value = 5)),
      p((actionButton(inputId = "button", label = "make table"))),
      htmlOutput("info")
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

makeTable <- function(nrow, input){
  filename <- tempfile()
  file.create(filename)
  for (i in 1:nrow) {
    future({
      # expensive operation here
      Sys.sleep(isolate(input$sleep))
      matrix(c(i, runif(10)), nrow = 1)
    }) %...>%
      as.data.frame() %...>%
      readr::write_csv(path = filename, append = TRUE)
  }

  reactiveFileReader(intervalMillis = 100, session = NULL,
                     filePath = filename,
                     readFunc = readr::read_csv, col_names = FALSE)
}

server <- function(input, output, session){
  timingInfo <- reactiveVal()
  output$info <- renderUI({ timingInfo() })

  output$random <- renderText({
    invalidateLater(100)
    paste("Something running in parallel: ", runif(1))
  })

  table_reader <- eventReactive(input$button, {
    start <- Sys.time()
    result <- makeTable(10, input)
    end <- Sys.time()
    duration <- end-start
    duration_sleep_diff <- duration-input$sleep
    timingInfo(p("start:", start, br(), "end:", end, br(), "duration:", duration, br(), "duration - sleep", duration_sleep_diff))
    return(result)
  })
  output$table = renderTable(table_reader()()) # nested reactives, double ()
}

shinyApp(ui, server)