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)

Not an answer directly, but if your goal is to show the user something is running, shinycssloaders is great for this. Try: textOutput("scenarioRuntime") %>% shinycssloaders::withSpinner() — VvdL
– VvdL, Commented Aug 26, 2022 at 13:57
Definitely something to keep in mind if I can't get this to work properly, thanks! — dnelson17
– dnelson17, Commented Aug 26, 2022 at 13:59
Because the body of observeEvent doesn't return until it's complete, no other code will run. It's blocking all other server code from running. shiny code doesn't run in parallel by default. The renderText can't run while the observeEvent is blocking. You'll probably need to get Javascript involved for such a behavior. See stackoverflow.com/questions/17325521/… — MrFlick
– MrFlick, Commented Aug 26, 2022 at 14:07

lz100 · Accepted Answer · 2022-08-26 18:32:53Z

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)

cheers, I like it! in my case I want to show an independent timer while things are rendering, which doesn't work well within the Shiny reactive domain, regardless of async and/or ExtendedTask. so actually sth like here stackoverflow.com/questions/47714010/…, but this is the better solution to me :)

Collectives™ on Stack Overflow

R Shiny - Update timer text output while function running

1 Answer 1

timer with async

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

timer with async

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related