Show computing progress without for loop

[ryamy]

I'd like to show some long-computing function's status in shiny UI under the following situation.

(1). I am not allowed to edit inside of long-computing function
(2). long-computing function print their status into R console

Due to this restriction (1) , I think I can not use withProgress() or something requires to put inside of the function. So I attempted to show R console output to shiny UI . Starting my app by R CMD BATCH myscript.R and shinytail can capture the update of logfile on the shiny UI.

My problem:
I can see update on logfile in shinyUI, but it is not realtime. In following code, logged print() messages will appear in shiny ui after long.calculation function is finished despite of redirected logfile is updated realtime (I confirmed redirected logfile is updated realtime by tail -F logfile in terminal).

How can I capture this long.calculation function's progress under this restrictions? I would appreciate any comments. Thanks!!

library(shiny)
library(shinydashboard)
library(shinytail)
options(shiny.port=3131, shiny.host='0.0.0.0')

## Restriction: I am not allowed to edit inside of long.calculation
long.calculation <- function(n){
    for (i in seq(1, n)){
        Sys.sleep(1)
        print(sprintf('Some logging %s: this logging will not appear in shiny ui in realtime..', i))
    }
}

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

    ## ***************************
    ## To run this script, I use:
    ## > R CMD BATCH ./example2.R
    ## ***************************
    logfile <- './example2.Rout'
    all_data <- reactiveVal(value=NULL, label='data')
    pr <- tailFile(logfile)

    observe({
        readStream(all_data, pr)
    })

    output$log <- renderText({
        paste(all_data(), collapse='\n')
    })
    
    observeEvent(input$exec, {
        n <- 30
        long.calculation(n)
        ## withProgress(message = 'Long calculation status',
        ##              detail = 'But this bar is start after long calculation is finished...', value = 0, {
        ##                  for (i in seq(1, n)) {
        ##                      incProgress(1/n)
        ##                      Sys.sleep(1)
        ##                  }
        ##              })
    })
}

sidebar <- dashboardSidebar(
    sidebarMenu(
        menuItem('Exec & Log', tabName='execlog', icon=icon('th'), selected=TRUE)
    )
)

body <- dashboardBody(
    tabItem(tabName = 'execlog',
            shinyTail('log'),
            actionButton('exec', 'Exec')
            )
)

ui <- dashboardPage(
    dashboardHeader(title='example'),
    sidebar,
    body
)

runApp(shinyApp(ui, server))

[pieterjanvc]

Hi,

Welcome to the RStudio community!

It is indeed true that Shiny will normally only refresh the output once all functions have finished running. However, I can think of one workaround. You could run the long functions separately in the background, and if you write its output to a file, you can then in Shiny read that file while it's being written to show the progress.

Instead of coming up with and example myself, I did a bit of research and found a post that gives a great example:

Stream system() output to Shiny front-end (continuously)

Alternative to the system command that is used in this post, you could also make use of the promises/future options in Shiny

Using `promises` with Shiny

Hope this helps,
PJ

[ryamy]

Thanks to your quick comments and research! So it is important that to run expensive calculation in different process, am I right? According to your suggestion, this time I followed SO's solution.

Following code works as expected in my environment. Thanks!!

##  example2.1.R
library(shiny)
library(shinydashboard)
options(shiny.port=3131, shiny.host='0.0.0.0')

n <- 30

## To stick scroll bar to the bottom of UI
htmlLogOutput <- function(outputId, placeholder = FALSE) {
  div(tags$head(
    tags$style(
    paste0("#", outputId, "{
      color: gray;
      font-size: 12px;
      max-height: 300px;
      font-style: italic;
      overflow-y: scroll;
      background: ghostwhite;
    }")
    ),
    tags$script(
      paste0('
      Shiny.addCustomMessageHandler("scrollCallback",
        function(a) {
          var objDiv = document.getElementById("', outputId, '");
          objDiv.scrollTop = objDiv.scrollHeight;
          }
      );'
    ))
  ),
  shiny::htmlOutput(
    outputId = outputId,
    placeholder = placeholder
    )
  )
}

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

    execStatus <- reactiveValues(textstream = c(""),
                                 timer = reactiveTimer(1000),
                                 started = FALSE)

    observeEvent(input$exec, { 
        execStatus$started <- TRUE
        args <- paste('long.computation.R', n, '>', 'long.computation.txt', sep=' ')
        system2('Rscript', args, wait = FALSE)
    })

    observeEvent(input$stop, {
        execStatus$started <- FALSE
    })
    observe({
        execStatus$timer()
        if (isolate(execStatus$started)==TRUE){
            execStatus$textstream <- paste(readLines('long.computation.txt'), collapse = '<br/>')
            session$sendCustomMessage(type='scrollCallback', 1)   
        }

    })
    output$log <- renderUI({
        HTML(execStatus$textstream)
    })
    
}

sidebar <- dashboardSidebar(
    sidebarMenu(
        menuItem('Exec & Log', tabName='execlog', icon=icon('th'), selected=TRUE)
    )
)

body <- dashboardBody(
    tabItem(tabName = 'execlog',
            actionButton('exec', 'Exec'),
            actionButton('stop', 'Stop'),
            htmlLogOutput('log'),
            )
)

ui <- dashboardPage(
    dashboardHeader(title='example'),
    sidebar,
    body
)

runApp(shinyApp(ui, server))

##  long.computation.R
## 
long.computation <- function(n){
    for (i in seq(1, n)){
        Sys.sleep(1)
        print(sprintf('Some logging %s: this time logging appears in shiny ui in realtime!!', i))
    }
}

args <- commandArgs()
## print(args)

n <- args[6]

long.computation(n)