Show Text Progress Bar in Shiny

Question

So I want to create a shinydashboardPlus GUI for a long-running function long_run_op that displays progress in the console. Here is a minimal example for that function:

    long_run_op <- function() {
        pb <- txtProgressBar(style=3, max=10)
        for(i in 1:10) {Sys.sleep(0.1); setTxtProgressBar(pb, i)}
        close(pb)
        return(rnorm(10))
    }

(If you're interested: I want to use the great keyATM::keyATM, which cannot be used with shiny::withProgress.)

Now I wish to display the console progress bar in the shiny app.

What I tried so far, is to use verbatimTextOutput. This does only display the return value. Also, the server function uses <<-, which does not only smell like bad practice, it does not even work -- the plot is never shown.

(EDIT: the plot not showing was because of a wrong function in the ui and is now fixed, thanks @stefan.)

    ui <- shinydashboardPlus::dashboardPage(
        header=shinydashboardPlus::dashboardHeader(),
        sidebar = shinydashboardPlus::dashboardSidebar(),

        body=shinydashboard::dashboardBody(
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::actionButton("run", "Run")
            ),
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::verbatimTextOutput("progress")
            ),
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::plotOutput("result")
            )
        )
    )

    server <- function(input, output, session) {
        observeEvent(input$run, {
            ans <- NA
            output$progress <- shiny::renderText({
                ans <<- long_run_op()
            })
            output$result <- shiny::renderPlot({
                plot(ans)
            })
        })
    }

    app <- shiny::shinyApp(ui, server)
    shiny::runApp(app, launch.browser=TRUE)

Still on the shiny learning curve, I am stuck here. Is there a way to make this work? Extra points if I can make the progress bar disappear after the calculation has finished.

EDIT2: Will sink help? Is there a way to display a textConnection object in Shiny?

EDIT3: I come to think that because of the single-threaded nature of Shiny the only chance I have is to redirect stdout to something in the browser. Using two processes seems too complicated to me.

EDIT4: Found this post. It seems that it is well possible to intercept and displays messages/warning/errors, but not cat output.

Answer 1

Is is what you want? Progress bar on console?

server <- function(input, output, session) {
  output$progress <- shiny::renderText({
    input$run
      ans <<- long_run_op()
  })
  output$result <- shiny::renderPlot({
    input$run
      plot(ans)
  })
  
}

Answer 2

So after some research I post my findings here for reference.

It seems that we cannot redirect (in "real-time") output generated with print or cat to shiny. (There is capture.output, but this is not suitable for displaying progress.)

However, we can define a callback for message (and warning and error), and in this callback we can update shiny. This works even for code written using Rcpp, there is a Rcpp::message function.

So while I could not find a way to get the function long_run_op running, I could -- with help of the keyATM package maintainer -- produce a progress bar in shiny for keyATM::keyATM. Here is an example:

devtools::install_github("keyATM/keyATM", ref = "Shiny")
library(keyATM)
library(quanteda)
library(shinydashboardPlus)
data(keyATM_data_bills)
bills_keywords <- keyATM_data_bills$keywords
bills_dfm <- keyATM_data_bills$doc_dfm  
keyATM_docs <- keyATM_read(bills_dfm)

ui <- shinydashboardPlus::dashboardPage(
    header=shinydashboardPlus::dashboardHeader(),
    sidebar = shinydashboardPlus::dashboardSidebar(),

    body=shinydashboard::dashboardBody(
        shinydashboardPlus::box(
            status="primary", width=12,
            shiny::fluidRow(
                shiny::column(4,
                    shiny::numericInput('num_topics', 'New Topics', 5, min=0, max=20)
                ),
                shiny::column(4,
                    shiny::numericInput('num_iter', 'Iterations', 300, min=150, max=5000)
                ),
                shiny::column(4,
                    shiny::actionButton("run_lda", "Run keyATM")
                )
            )
        ),
        
        shinydashboardPlus::box(
            status="primary", width=12,
            shiny::plotOutput("result")
        )
    )
)

server <- function(input, output, session) {
    shiny::observeEvent(input$run_lda, {
        shiny::withProgress(
            withCallingHandlers(
                out <- keyATM(
                    docs = keyATM_docs, 
                    model = "base", 
                    no_keyword_topics = input$num_topics, 
                    keywords = bills_keywords,
                    options=list(verbose=TRUE, iterations=input$num_iter)
                ),
                message=function(m) if(grepl("^\\[[0-9]+\\]", m$message)) {
                    val <- as.numeric(gsub("^\\[([0-9]+)\\].*$", "\\1", m$message))
                    shiny::setProgress(value=val)
                }
            ),
            message="fitting model..",
            max=input$num_iter,
            value=0
        )
        output$result <- shiny::renderPlot(keyATM::plot_modelfit(out))
    })
}

app <- shiny::shinyApp(ui, server)
shiny::runApp(app, launch.browser=TRUE)