etomilina
etomilina

Reputation: 31

How to display console progress bar output in shiny app?

I am currently making a Shiny app which computes a correlation matrix via the function denoted f()in the example below from an input dataset. Because it takes quite some time, I would like to display a progress bar. In Rstudio, the function f() runs in parallel with a foreach loop and uses txtProgressbar() as well as the doSNOW package to display the progress bar in the console.

However, it is actually part of a package that I have developed so the loop is not present explicitly in the server.R part of my shiny app and I cannot apply any methods I have found online to display the bar (also not sure how they could handle the parallelization). When I run the app, the bar appears in the Rstudio console but is not displayed on the shiny interface.

I would like to display the progress bar in my shiny app while the matrix is being computed. Below is the part of my code needed to understand the issue:

  #importing all needed packages

    ui <- fluidPage(
    fileInput("data", "Your data here", accept=".csv"),
    #some other inputs and outputs that work well
    tableOutput("matrix")
    )

    server <- function(input,output){

        # This is my data importation in a reactive object
            dataframe <- reactive({
                file <- input$data
                ext <- tools::file_ext(file$datapath)
                req(file)
                validate(need(ext == "csv", "Please upload a csv file"))
                read.csv2(file$datapath, header = TRUE,sep=";")
                })
        # This is my matrix estimation via my function f()
            mtrx <- reactive({
                f(dataframe())
                })
        # This is the display
           output$matrix <- renderTable({
                mtrx()
                })
        #some other inputs and outputs that work well
    }

I guess I should have some renderText for the progress bar displayed by f() and a textOutput with it above tableOutput("matrix") in my UI, but I don't know how to access this object when running f() which returns the matrix only.

Thank you in advance and do not hesitate to ask for clarifications!

Upvotes: 1

Views: 82

Answers (2)

Ifeanyi Idiaye
Ifeanyi Idiaye

Reputation: 1064

A hack would be to make the duration of the progress bar equal to the runtime of the code. To calculate code runtime, use tictoc package like this:

tic()

</some code>

toc()

Now, you can use withProgress() to display a progress bar whose duration equals the runtime of your code like this:

withProgress(message = "Fetching data",
                 detail = "This may take a while...",value = 0,{
                   
                   for (i in 1:25){
                     
                     incProgress(1/25)
                     Sys.sleep(0.25)
                   }
                 })    

This is merely a hack for your problem, which may or may not suffice for your use case.

Upvotes: -1

Mikko Marttila
Mikko Marttila

Reputation: 11878

Wrap f() in an ExtendedTask to be able to update the UI while it’s running. Then redirect the progress bar output into a file with sink(). Finally periodically read the contents of the file with a reactiveFileReader() for display:

library(shiny)
library(mirai)

f <- function(n) {
  pb <- txtProgressBar(0, n)
  for (i in seq_len(n)) {
    Sys.sleep(0.01)
    setTxtProgressBar(pb, i)
  }
  42
}

ui <- fluidPage(
  sliderInput("n", "n", 1, 200, 100),
  actionButton("go", "Go"),
  verbatimTextOutput("progress"),
  verbatimTextOutput("result"),
)

PROGRESS_FILE <- "progress.txt"

server <- function(input, output, session) {
  task <- ExtendedTask$new(function(n) {
    mirai({
      sink(PROGRESS_FILE)
      on.exit(sink())
      f(n)
    }, f = f, n = n, PROGRESS_FILE = PROGRESS_FILE)
  })
  observeEvent(input$go, task$invoke(input$n))
  
  progress <- reactiveFileReader(100, session, PROGRESS_FILE, function(path) {
    if (file.exists(path)) readLines(path, 1, warn = FALSE)
  })
  output$progress <- renderText({ progress() })
  
  observeEvent(task$result(), unlink(PROGRESS_FILE))
  output$result <- renderText({ task$result() })
}

shinyApp(ui, server)

Upvotes: 4

Related Questions