---
title: "Asynchronous Shiny apps"
author: "Will Landau and Daniel Woodie"
output:
  rmarkdown::html_vignette:
    toc: true
    number_sections: true
vignette: >
  %\VignetteIndexEntry{Asynchronous Shiny apps}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

# About

Shiny has revolutionized interactive web apps in R. However, because of the staggering breadth of possibilities it created, the official ecosystem still has unmet needs. In particular, long-running tasks are challenging because they may block the R session and cause the app to lag. Any degree of latency is detrimental because web app users expect instant responses. Long tasks should run asynchronously to free up the main process for user interactions.

The [`promises`](https://rstudio.github.io/promises/) package is a popular solution for asynchronous programming in Shiny. With the help of [`future`](https://future.futureverse.org/), it keeps the main process free and responsive. However, as [its own documentation explains](https://rstudio.github.io/promises/articles/intro.html), the [`promises`](https://rstudio.github.io/promises/) package focuses on apps with only a small number of specific bottlenecks. By design, it does not scale to the prodigious quantities of heavy tasks that industrial enterprise-level apps aim to farm out in production-level pipelines.

By contrast, `crew` scales out easily, and its controller asynchronously manages all the tasks from a single convenient place. This vignette demonstrates scalable asynchronous programming with `crew` in Shiny.

# Example

We focus on the `crew`-powered Shiny app at <https://wlandau.shinyapps.io/crew-shiny/>. When it launches, it looks like this:

![](./figures/open.png)

When you click the "Submit a task (5 seconds)" button, `crew` runs a long task in the background. Here, the task is to wait 5 seconds and then generate a random [phyllotaxis](https://en.wikipedia.org/wiki/Phyllotaxis) using the [`aRtsy`](https://koenderks.github.io/aRtsy/) package.^[Machine learning and Bayesian data analysis have plenty of serious examples of long-running tasks.] The app continuously refreshes the current time and the number of tasks in progress.

![](./figures/submitted.png)

As soon as a task completes, the app retrieves the result from the `crew` workers and plots the output.

![](./figures/completed1.png)

You can submit many more tasks than there are workers currently running. In the following screenshot, the app is only running 4 workers, but the queue has 9 tasks left.

![](./figures/progress.png)

Thanks to the efficient scheduling of [`mirai`](https://github.com/shikokuchuo/mirai) in the backend, `crew` workers successfully complete all remaining 9 tasks. Because the app runs 4 workers, different plots may appear less than 5 seconds apart.

![](./figures/completed2.png)

# Tutorial

The app depends on the following packages.

```r
library(crew)
library(shiny)
library(ggplot2)
library(aRtsy)
```

Each task waits 5 seconds and then generates a random [phyllotaxis](https://en.wikipedia.org/wiki/Phyllotaxis) [`ggplot`](https://ggplot2.tidyverse.org/) using the [`canvas_phyllotaxis()`](https://koenderks.github.io/aRtsy/reference/canvas_phyllotaxis.html) function from [`aRtsy`](https://koenderks.github.io/aRtsy/).

```r
run_task <- function() {
  Sys.sleep(5)
  canvas_phyllotaxis(
    colors = colorPalette(name = "random", n = 3),
    iterations = 1000,
    angle = runif(n = 1, min = - 2 * pi, max = 2 * pi),
    size = 1,
    p = 1
  )
}
```

A separate function generates status messages based on the number of tasks in progress.

```r
status_message <- function(n) {
  if (n > 0) {
    paste(format(Sys.time()), "tasks in progress:", n)
  } else {
    "All tasks completed."
  }
}
```

The [user interface](https://shiny.rstudio.com/articles/basics.html) has a button to submit a task, a text output with the status, and a plot with the result of the most recently completed task.

```r
ui <- fluidPage(
  actionButton("task", "Submit a task (5 seconds)"),
  textOutput("status"),
  plotOutput("figure")
)
```

The [server](https://shiny.rstudio.com/articles/basics.html) begins with reactive values and outputs for the random [phyllotaxis](https://en.wikipedia.org/wiki/Phyllotaxis) plot and the task status. In addition, `reactive_poll` controls when the app scans for results.

```r
server <- function(input, output, session) {
  reactive_result <- reactiveVal(ggplot())
  reactive_status <- reactiveVal("No task submitted yet.")
  reactive_poll <- reactiveVal(FALSE)
  output$result <- renderPlot(reactive_result(), height = 600, width = 600)
  output$status <- renderText(reactive_status())
```

Next, we start a `crew` controller with up to 4 workers and an idle time of 10 seconds. We choose the [local process launcher](https://wlandau.github.io/crew/reference/crew_class_launcher_local.html) below for this app, but we could have chosen the Sun Grid Engine (SGE) launcher from [`crew.cluster`](https://wlandau.github.io/crew.cluster/), a [controller group](https://wlandau.github.io/crew/articles/controller_groups.html) with multiple launchers, or a [custom launcher](https://wlandau.github.io/crew/articles/launcher_plugins.html) for e.g. [Kubernetes](https://kubernetes.io). With `crew`, anyone can write a [custom launcher plugin](https://wlandau.github.io/crew/articles/launcher_plugins.html).

```r
  controller <- crew_controller_local(workers = 4, seconds_idle = 10)
  controller$start()
  onStop(function() controller$terminate())
```

Every time the user presses the "Submit a task (5 seconds)" button, the app pushes a new task to the `crew` controller, and the task will start when a worker is available. We set `reactive_poll()` to `TRUE` to tell the app to scan for results in the `observe()` block covered next.

```r
  observeEvent(input$task, {
    controller$push(
      command = run_task(),
      data = list(run_task = run_task),
      packages = "aRtsy"
    )
    reactive_poll(TRUE)
  })
```

At the bottom of `server()` is the crux of the app: the event loop that scans for results. The leading `req(reactive_poll())` ensures the loop only runs when results could come in, and the `reactive_poll(controller$nonempty())` at the end turns off polling when everything is all done. `invalidateLater(millis = 100)` says to poll every 0.1 seconds when polling is activated.^[`controller$pop()` is inexpensive, especially when there are no workers to relaunch or results to collect. In practice, the polling interval is a balance between responsiveness and CPU usage, and it may not be 0.1 seconds for every app.] The other three lines collect a result, plot it if available, and update the status message.

```r
  observe({
    req(reactive_poll())
    invalidateLater(millis = 100)
    result <- controller$pop()$result
    if (!is.null(result)) reactive_result(result[[1]])
    reactive_status(status_message(n = sum(controller$schedule$summary())))
    reactive_poll(controller$nonempty())
  })
}
```

Finally, `shinyApp()` runs the app with the UI and server defined above.

```r
shinyApp(ui = ui, server = server)
```

# Code

See below for the complete `app.R` file.

```r
library(crew)
library(shiny)
library(ggplot2)
library(aRtsy)

run_task <- function() {
  Sys.sleep(5)
  canvas_phyllotaxis(
    colors = colorPalette(name = "random", n = 3),
    iterations = 1000,
    angle = runif(n = 1, min = - 2 * pi, max = 2 * pi),
    size = 1,
    p = 1
  )
}

status_message <- function(n) {
  if (n > 0) {
    paste(format(Sys.time()), "tasks in progress:", n)
  } else {
    "All tasks completed."
  }
}

ui <- fluidPage(
  actionButton("task", "Submit a task (5 seconds)"),
  textOutput("status"),
  plotOutput("result")
)

server <- function(input, output, session) {
  # reactive values and outputs
  reactive_result <- reactiveVal(ggplot())
  reactive_status <- reactiveVal("No task submitted yet.")
  reactive_poll <- reactiveVal(FALSE)
  output$result <- renderPlot(reactive_result(), height = 600, width = 600)
  output$status <- renderText(reactive_status())
  
  # crew controller
  controller <- crew_controller_local(workers = 4, seconds_idle = 10)
  controller$start()
  onStop(function() controller$terminate())
  
  # button to submit a task
  observeEvent(input$task, {
    controller$push(
      command = run_task(),
      data = list(run_task = run_task),
      packages = "aRtsy"
    )
    reactive_poll(TRUE)
  })
  
  # event loop to collect finished tasks
  observe({
    req(reactive_poll())
    invalidateLater(millis = 100)
    result <- controller$pop()$result
    if (!is.null(result)) reactive_result(result[[1]])
    reactive_status(status_message(n = sum(controller$schedule$summary())))
    reactive_poll(controller$nonempty())
  })
}

shinyApp(ui = ui, server = server)
```
