One of the great additions to the R ecosystem in recent years is RStudio’s Shiny package. With it, you can easily whip up and share a user interface for a new statistical method in just a few hours. Today I want to share some of the methods and challenges that come up when the actual computation of a result takes a non-trivial amount of time (e.g >5 seconds).
First Attempt
Shiny operates in a reactive programming framework. Fundamentally this means that any time any UI element that affects the result changes, so does the result. This happens automatically, with your analysis code running every time a widget is changed. In a lot of cases, this is exactly what you want and it makes Shiny programs concise and easy to make; however in the case of long running processes, this can lead to frozen UI elements and a frustrating user experience.
The easiest solution is to use an Action Button and only run the analysis code when the action button is clicked. Another important component is to provide your user with feedback as to how long the analysis is going to take. Shiny has nice built in progress indicators that allow you to do this.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Long Run"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
actionButton('run', 'Run')
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
N <- 10
result_val <- reactiveVal()
observeEvent(input$run,{
result_val(NULL)
withProgress(message = 'Calculation in progress', {
for(i in 1:N){
# Long Running Task
Sys.sleep(1)
# Update progress
incProgress(1/N)
}
result_val(quantile(rnorm(1000)))
})
})
output$result <- renderTable({
result_val()
})
}
# Run the application
shinyApp(ui = ui, server = server)
The above implementation has some of the things we want out of our interface:
- The long running analysis is only executed when "Run" is clicked.
- Progress is clearly displayed to the user.
It does have some serious downsides though:
- If "Run" is clicked multiple times, the analysis is run back to back. A frustrated user can easily end up having to abort their session because they clicked to many times.
- There is no way to cancel the calculation. The session's UI is locked while the computation takes place. Often a user will realize that some of the options they've selected are incorrect and will want to restart the computation. With this interface, they will have to wait however long the computation takes before they can fix the issue.
- The whole server is blocked while the computation takes place. If multiple users are working with the app, the UIs of all users are frozen while any one user has an analysis in progress.
A Second Attempt With Shiny Async
Having the whole server blocked is a big issue if you want to have your app scale beyond a single concurrent user. Fortunately, Shiny's new support of asynchronous processing can be used to remove this behavior. Instead of assigning a value to the reactive value 'result_val', we will instead create a promise to execute the analysis in the future (using the future function) and when it is done assign it to result_val (using %...>%).
library(shiny)
library(promises)
library(future)
plan(multiprocess)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Long Run Async"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
actionButton('run', 'Run')
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
N <- 10
result_val <- reactiveVal()
observeEvent(input$run,{
result_val(NULL)
future({
print("Running...")
for(i in 1:N){
Sys.sleep(1)
}
quantile(rnorm(1000))
}) %...>% result_val()
})
output$result <- renderTable({
req(result_val())
})
}
# Run the application
shinyApp(ui = ui, server = server)
When "Run" is clicked, the UI is now blocked only for the individual performing the analysis. Other users will be able to perform analyses of there own concurrently. That said, we still have some undesirable properties:
- If "Run" is clicked multiple times, the analysis is run back to back.
- There is no way to cancel the calculation.
- The user cannot monitor progress. Shiny's progress bar updates do not support calling them from within future, so we've had to remove the progress bar from the UI. This is not a huge problem for tasks that take a few seconds, but for those that take minutes or hours, not knowing how long until the results show up can be very frustrating.
Third Time Is the Charm
In order to solve the cancel and monitoring problems, we need to be able to communicate between the app and the inside of the promise. This can be accomplished with the use of a file, where progress and interrupt requests are read and written. If the user clicks the cancel button, "interrupt" is written to the file. During the course of the computation the analysis code checks whether interrupt has been signaled and if so, throws an error. If no interrupt has been requested, the analysis code writes its progress to the file. If Status is clicked, Shiny reads the file and notifies the user of its contents.
The last addition to the code is to create a reactive value nclicks that prevents the Run button from triggering multiple analyses.
library(shiny)
library(promises)
library(future)
plan(multiprocess)
ui <- fluidPage(
titlePanel("Long Run Stoppable Async"),
sidebarLayout(
sidebarPanel(
actionButton('run', 'Run'),
actionButton('cancel', 'Cancel'),
actionButton('status', 'Check Status')
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
N <- 10
# Status File
status_file <- tempfile()
get_status <- function(){
scan(status_file, what = "character",sep="\n")
}
set_status <- function(msg){
write(msg, status_file)
}
fire_interrupt <- function(){
set_status("interrupt")
}
fire_ready <- function(){
set_status("Ready")
}
fire_running <- function(perc_complete){
if(missing(perc_complete))
msg <- "Running..."
else
msg <- paste0("Running... ", perc_complete, "% Complete")
set_status(msg)
}
interrupted <- function(){
get_status() == "interrupt"
}
# Delete file at end of session
onStop(function(){
print(status_file)
if(file.exists(status_file))
unlink(status_file)
})
# Create Status File
fire_ready()
nclicks <- reactiveVal(0)
result_val <- reactiveVal()
observeEvent(input$run,{
# Don't do anything if analysis is already being run
if(nclicks() != 0){
showNotification("Already running analysis")
return(NULL)
}
# Increment clicks and prevent concurrent analyses
nclicks(nclicks() + 1)
result_val(data.frame(Status="Running..."))
fire_running()
result <- future({
print("Running...")
for(i in 1:N){
# Long Running Task
Sys.sleep(1)
# Check for user interrupts
if(interrupted()){
print("Stopping...")
stop("User Interrupt")
}
# Notify status file of progress
fire_running(100*i/N)
}
#Some results
quantile(rnorm(1000))
}) %...>% result_val()
# Catch inturrupt (or any other error) and notify user
result <- catch(result,
function(e){
result_val(NULL)
print(e$message)
showNotification(e$message)
})
# After the promise has been evaluated set nclicks to 0 to allow for anlother Run
result <- finally(result,
function(){
fire_ready()
nclicks(0)
})
# Return something other than the promise so shiny remains responsive
NULL
})
output$result <- renderTable({
req(result_val())
})
# Register user interrupt
observeEvent(input$cancel,{
print("Cancel")
fire_interrupt()
})
# Let user get analysis progress
observeEvent(input$status,{
print("Status")
showNotification(get_status())
})
}
# Run the application
shinyApp(ui = ui, server = server)
All three of the problems with the original async code have been solved with this implementation. That said, some care should be taken when using async operations like this. It is possible for race conditions to occur, especially if you have multiple "Run" buttons in a single app.
Final Thoughts
It is great that Shiny now supports Asynchronous programming. It allows applications to be scaled much more easily, especially when long running processes are present. Making use of these features does add some complexity. The final implementation has ~ 3 times more lines of code compared to the first (naive) attempt.
It is less than ideal that the user has to click a button to get the status of the computation. I'd much prefer it if we were able to remove this button and just have a progress bar; however this is currently not possible within Shiny proper, though it might be achievable to inject some kludgy javascript magic to get a progress bar.