2

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?

Stefan F
  • 2,573
  • 1
  • 17
  • 19
  • 1
    Your example is about two different operations (btn fast clicked and btn slow clicked), but you want to have just one operation which can be either slow or fast, right? So sth. like `Sys.sleep(runif(1))` instead? I'm asking to clarify the question. – danlooo May 04 '22 at 07:19
  • It's the same operation, but for the example I wanted to provide both scenarios. The question is how to suppress the modal in "fastButton" without removing the showModal/removeModal code. I'll add comments to clarify – Stefan F May 04 '22 at 07:47
  • 2
    R is single threaded. You'll need to run the slow operation in an async process if you want shiny to check how long it takes, otherwise the process running shiny is busy with the slow operation. `r_bg` from `library(callr)` can be used to run background R processes. See [this](https://stackoverflow.com/a/71096495/9841389) or [this](https://stackoverflow.com/a/71495290/9841389) for an example. As an alternative using `promises` [is also possible](https://github.com/rstudio/promises/issues/23#issuecomment-386687705). – ismirsehregal May 04 '22 at 09:10
  • 1
    But in the end even async can't help here. What's the threshold? If you wait 5s before showing the modal and the process takes 5.4s the modal will be flashing again. Maybe using something less noticeable like [progress indicators](https://shiny.rstudio.com/articles/progress.html) or [spinners](https://dreamrs.github.io/shinyWidgets/reference/addSpinner.html) is the way to go. – ismirsehregal May 04 '22 at 09:16
  • I just want a delay for showing the modal, async doesn't help here. I.E. the modal should only show after 0.5 seconds (if `removeModal()` isn't called first). – Stefan F May 04 '22 at 12:20
  • 1
    Do you have the possibility to interrupt/pause the slow operation after 0.5s? If not an async process would be needed. – ismirsehregal May 04 '22 at 12:45

1 Answers1

1

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)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Thanks, this indeed works very well. I am still hoping for a clientside javascript/css solution, so I'll leave this open for now. If none else comes up with something I'll mark this as the solution. – Stefan F May 07 '22 at 17:55