R Shiny - Update timer text output while function running

Question

When the actionButton("run") button in this R Shiny app is pressed, a function is run that will take around a minute to complete, replaced with a Sys.sleep(10) for simplicity. I have created the textOutput("scenarioRuntime") in order to give the user some sort of feedback that the function is running and how long it has been for.

However, when I run this, in it's current state it will not show any output. If I comment out the req(scenario_timer$running) statement within the renderText, then the timer does update the runtime from the correct start time properly as desired, however, it will only begin displaying after the Sys.sleep() has finished running, so you only get feeback after the function has ran, which is useless.

Is there any way to get this timer to begin running and displaying while while the "run" button and stop when the function is finished?

library(shiny)

ui <- fluidPage(
  actionButton("run", "Run"),
  textOutput("scenarioRuntime")
)

# Server logic
server <- function(input, output, session) {
  scenario_timer <- reactiveValues(running = FALSE, start = NULL)

  observeEvent(input$run, {
    scenario_timer$running <- TRUE
    scenario_timer$start <- Sys.time()
    
    ret_data <- list()
    # Some code here that populates "return data" (ret_data)
    # ---
    Sys.sleep(10)
    # ---
    
    scenario_timer$running <- FALSE

    ret_data
  })


  output$scenarioRuntime <- renderText({
    req(scenario_timer$running)
    
    invalidateLater(1000, session)
    
    format(Sys.time() - scenario_timer$start)
  })

}
shinyApp(ui = ui, server = server)

Answer 1

I integrated an answer from this post to shiny.

library(shiny)

ui <- fluidPage(
    actionButton("run", "Run"),
    p(id = "scenarioRuntime", tags$label(class = "minutes"), tags$label(class = "seconds")),
    tags$script(HTML(
        '
        $(function(){
            var timer;
            
            Shiny.addCustomMessageHandler("timer", function(data){
                if(data.event === "end") return clearInterval(timer);
                
                var minutesLabel = document.querySelector(`#${data.id} .minutes`);
                var secondsLabel = document.querySelector(`#${data.id} .seconds`);
                var totalSeconds = 0;

                function pad(val) {
                  var valString = val + "";
                  if (valString.length < 2) {
                    return "0" + valString;
                  } else {
                    return valString;
                  }
                }
                function setTime() {
                  ++totalSeconds;
                  secondsLabel.innerHTML = pad(totalSeconds % 60);
                  minutesLabel.innerHTML = `${pad(parseInt(totalSeconds / 60))} : `;
                }
                
                timer = setInterval(setTime, 1000);
            });
        });
        '
    ))
)

# Server logic
server <- function(input, output, session) {
    observeEvent(input$run, {
        # start singal 
        session$sendCustomMessage('timer', list(id = "scenarioRuntime", event = "start"))
        # end signal, on.exit makes sure that the timer will stop no matter if it is 
        # complete or stop due to error
        on.exit(session$sendCustomMessage('timer', list(id = "scenarioRuntime", event = "end")))

        Sys.sleep(5)
    })

}
shinyApp(ui = ui, server = server)

timer with async

To use more than one timers at the same time, we would need to use shiny async library {promises} and {future}.

This is an example to show you how you can run two processes in parallel in Shiny with timers.

library(shiny)
library(promises)
library(future)
plan(multisession)

ui <- fluidPage(
    actionButton("run1", "Run 1"),
    p(id = "scenarioRuntime1", tags$label(class = "minutes"), tags$label(class = "seconds")),
    actionButton("run2", "Run 2"),
    p(id = "scenarioRuntime2", tags$label(class = "minutes"), tags$label(class = "seconds")),
    tags$script(HTML(
        '
        $(function(){
            var timer = {};
            
            Shiny.addCustomMessageHandler("timer", function(data){
                if(data.event === "end") return clearInterval(timer[data.id]);
                
                var minutesLabel = document.querySelector(`#${data.id} .minutes`);
                var secondsLabel = document.querySelector(`#${data.id} .seconds`);
                var totalSeconds = 0;

                function pad(val) {
                  var valString = val + "";
                  if (valString.length < 2) {
                    return "0" + valString;
                  } else {
                    return valString;
                  }
                }
                function setTime() {
                  ++totalSeconds;
                  secondsLabel.innerHTML = pad(totalSeconds % 60);
                  minutesLabel.innerHTML = `${pad(parseInt(totalSeconds / 60))} : `;
                }
                
                timer[data.id] = setInterval(setTime, 1000);
            });
        });
        '
    ))
)

# Server logic
server <- function(input, output, session) {
    mydata1 <- reactiveVal(FALSE)
    observeEvent(input$run1, {
        future_promise({
            Sys.sleep(5)
            TRUE
        }) %...>%
            mydata1()
        # the future_promise will return right away, so if it runs then we start timer
        session$sendCustomMessage('timer', list(id = "scenarioRuntime1", event = "start"))
    })
    observeEvent(mydata1(), {
        req(mydata1())
        session$sendCustomMessage('timer', list(id = "scenarioRuntime1", event = "end"))
    })

    mydata2 <- reactiveVal(FALSE)
    observeEvent(input$run2, {
        future_promise({
            Sys.sleep(5)
            TRUE
        }) %...>%
            mydata2()
        session$sendCustomMessage('timer', list(id = "scenarioRuntime2", event = "start"))
    })
    observeEvent(mydata2(), {
        req(mydata2())
        session$sendCustomMessage('timer', list(id = "scenarioRuntime2", event = "end"))
    })
}
shinyApp(ui = ui, server = server)