How can I change UI elements before and after a future?

[sbo]

Hello,

Brand new to the world of Shiny, but I have experience with React.
I am currently doing experiments to see how far I can get with shiny, and I have the following rather standard problem. This is the exercise:

• respond to a button being pressed
• After the click, change the UI to show something like "Loading"
• spawn a request to a remote server (using aws.s3)
• when the request is completed. change the UI to show "Done".
• publish the request results in a table.

I tried various experiments, but I am unable to get it to work. This is the code

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()
  })

}

It is my understanding from the documentation that the event loop is always waiting for the future completion before doing another round of event dispatch, which is kind of odd. How can I achieve the above result in Shiny without tricks sidestepping the issue (such as the ones in shinycssloaders)?

Thanks

[pieterjanvc]

Hi,

As far as my knowledge goes, I'm afraid this will not be possible without any hacks as Shiny always waits for a process to finish before updating the UI.

If you're looking for a simple progress message, that is possible through the Progress function
https://shiny.rstudio.com/reference/shiny/0.14/Progress.html

If you really want to update a UI element, you'll need custom JS as far as I can see. I've come up with one example:

library(shiny)
library(shinyjs)

ui <- fluidPage(useShinyjs(),
                tags$script(HTML(
                  "
      $(document).on('shiny:inputchanged', function(event) {
        if (event.name === 'myButton') {
          document.getElementById('myUI').innerHTML = '<h1>loading...</h1>';
        }
      });
      "
                )),
                
  actionButton("myButton", "Click"),
  uiOutput("myUI")
)

server <- function(input, output, session) {
  
  theUI = reactiveVal(tags$h1("Initial state"))

  observeEvent(input$myButton, {
    Sys.sleep(3)
    # theUI("Done") # wont work after first time
    output$myUI = renderUI({
      tags$h1("Done")
    })
  })
  
  output$myUI = renderUI({
    theUI()
  })

}

shinyApp(ui, server)

I took advantage of the client side JS to update the UI element of interest when the button is clicked, regardless of how long the process takes.

Unfortunately, this does not update any reactive variables in Shiny. I found this out because I originally had the line theUI("Done") to update the UI once the code finished. This works the first time round, but because it's not updated to loading... as this is done client side, the value stays the same and the next time this won't trigger the output$myUI as Shiny does not execute reactive variables if they don't change value. I hoep this makes sense (just try it). I fixed that by calling the output$myUI directly in the code to force the update.

Hope this helps,
PJ

[sbo]

Thank you for your input.

I am then confused on the purpose of using futures, because this means that server side you will always have a "synchronization" operation at the end of the event loop iteration before a new one is started. Long running operations (in the order of minutes) will hang the server anyway.

[pieterjanvc]

Hi,

I'm not a developer, but yes I think you are correct... the only way I know of to run a long running process without hanging the app is to invoke another R instance (and I don't have any experience with that).

Let's hope some the the experts have more to say on this

Grtz,
PJ

[ismirsehregal]

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)

the only way I know of to run a long running process without hanging the app is to invoke another R instance

From ?multiprocess:

A multiprocess future is a future that uses multicore evaluation if supported, otherwise it uses multisession evaluation. Regardless, its value is computed and resolved in parallel in another process.

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 (Edit: I just noticed you already read it ).

[pieterjanvc]

@ismirsehregal

That's an amazing solution! I never heard of that package. Very useful... will definitely explore it more.

PJ

[sbo]

First of all. Thank you all for the answers.

I tested it and it does indeed work. Marking as solution.