Unable to render "loading" using Shiny and futures

Question

I am trying to use futures to have a "loading" icon appear. This is the code I have

library(shiny)
library(promises)
library(future)
plan(multiprocess) 

disksUI <- function(id) {
  ns <- NS(id)
  fluidRow(
    box(
      uiOutput(ns("loading")),
      dataTableOutput(ns("filelist")),
      width=12
    )
  )
}

disksServer <- function(input, output, session) {
  state <- reactiveValues(onLoading=FALSE)

  observe({
    if (state$onLoading) {
      output$loading <- renderUI("Loading")
    } else {
      output$loading <- renderUI("Done")
    }
  })

  filelist <- reactive(
    {
      state$onLoading <- TRUE
      future({
        Sys.sleep(3)
        state$onLoading <- FALSE
       }
      )
    }
  )

  output$filelist <- renderDataTable({
    filelist()
  })

}

However, the result is not what I expect. What I expect is

• the string Loading appears immediately
• after three seconds, the string Loading is replaced with Done

What happens is

• Nothing is written for three seconds.
• After three seconds, the Loading string appears.

Phrenology

I'd suggest exploring the package shinycssloaders - provides spinners while things are loading, not held up by other things that need to load. – Anabiosis

@Megan that package uses a trick. The spinner is always there, it's just at a z-index that makes it invisible, and hopes that it appears because the replotting makes the top layer go away, which is not my case. Besides, it is not using any futures. This is not about solving the spinner problem. it's about understanding how to handle the above use case (adding a new UI element after an async request), which works in React. – Phrenology

Answer 1

I posted my answer here first. However, adding it also here for future readers:

Here is a working example:

library(shiny)
library(shinydashboard)
library(promises)
library(future)
library(shinyjs)
plan(multiprocess)

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

  output$loading <- renderUI("Idling")

  myFilelist <- reactiveVal(NULL)

  observeEvent(input$getBtn, {

    disable("getBtn")
    output$loading <- renderUI("Loading")

    myFuture <- future({
      Sys.sleep(3)
      data.frame(list.files(getwd()))
    })

    then(myFuture, onFulfilled = function(value) {
      enable("getBtn")
      output$loading <- renderUI("Done")
      myFilelist(value)
    },
    onRejected = NULL)

    return(NULL)
  })

  output$filelist <- renderDataTable({
    myFilelist()
  })

}

ui <- fluidPage(
  useShinyjs(),
  fluidRow(
    actionButton("getBtn", "Get file list"),
    box(
      uiOutput("loading"),
      dataTableOutput("filelist"),
      width=12
    )
  )
)

shinyApp(ui, server)

Please note the return(NULL) in the observeEvent() - this is hiding the future from its own session - allowing intra-session responsiveness. However, now we have to deal with potential race conditions, as Joe Cheng already mentioned to you here. In this simple example we can disable the trigger button to avoid users having the possibility of creating new futures while others are still beeing processed. For further details please read this.

Memo