How to show a shiny modal only if a certain operation takes longer than expected?

user_2622641 0
Viewed 135

I have a small shiny app that executes an operation that is sometimes instantaneous and sometimes takes a few seconds. In the later case, I want to display a modal. The following works pretty well if the operation takes long; but it also flashes the modal for a few ms on the instant operation; which is pretty ugly.

library(shiny)

ui <- fluidPage(
  # In the real app, there is only one operation that can either be fast or slow. 
  # The buttons in this example represent both possible scenarios.
  actionButton("slowButton", "save slow"),
  actionButton("fastButton", "save fast")
)

server <- function(input, output, session) {
  observeEvent(input$slowButton, {
    showModal(modalDialog("Saving..."))
    Sys.sleep(3)
    removeModal()
  })

  observeEvent(input$fastButton, {
    # The modal should be suppressed here, because the operation is fast enough.
    showModal(modalDialog("Saving..."))
    Sys.sleep(0)  # In reality, we do not know how long this takes.
    removeModal()
  })

}

shinyApp(ui, server)

Is there a way to add a delay to display the modal only if the operation takes longer than, let's say, half a second?

shiny r javascript
1 Answers

Here is an example on what I've outlined in the comments. However, for a delay time of only 0.5s to show the modal, the overhead to create a background process might be too much.

library(shiny)
library(shinyjs)
library(callr)

ui <- fluidPage(
  useShinyjs(),
  actionButton("saveButton", "save"),
)

server <- function(input, output, session) {
  rv <- reactiveValues(bg_process = NULL, retry_count = 0)
  
  observeEvent(input$saveButton, {
    disable("saveButton")
    unknown_duration <- round(runif(1L, max = 2L), digits = 1)
    print(paste0(Sys.time(), " - unknown process duration: ", unknown_duration, "s"))
    rv$bg_process <- r_bg(
      func = function(duration){
        Sys.sleep(duration)
        return("result")
      },
      args = list(duration = unknown_duration))
  })
  
  observe({
    req(rv$bg_process)
    if (rv$bg_process$poll_io(0)["process"] == "ready") {
      print(paste(Sys.time(), "-", rv$bg_process$get_result()))
      rv$retry_count <- 0
      enable("saveButton")
      removeModal()
      if(rv$bg_process$is_alive() == FALSE){
        rv$bg_process <- NULL # reset
      }
    } else {
      invalidateLater(1000)
      if(isolate({rv$retry_count}) == 3L){
        print(paste(Sys.time(), "- showModal"))
        showModal(modalDialog("Saving...")) 
      } else {
        print(paste(Sys.time(), "- waiting"))
      }
    }
    isolate({rv$retry_count <- rv$retry_count + 1})
  })
  
}

shinyApp(ui, server)
user_98413890
Related