mirai - Shiny Integration

Shiny Integration

mirai may be used as an asynchronous backend to scale Shiny applications.

Depending on the options suppled to daemons(), mirai tasks may be distributed across local background processes or multiple networked servers in an efficient and performant manner.

For use with Shiny, mirai implements truly event-driven promises, developed in collaboration with Joe Cheng (creator of Shiny).

mirai natively supports Shiny ExtendedTask to create scalable Shiny apps, which remain responsive intra-session for each user, as well as inter-session for multiple concurrent users.

‘mirai’ may be used anywhere a ‘promise’ or ‘future_promise’ would be accepted (with promises >= 1.3.0).

Shiny ExtendedTask: Introductory Example

In the example below, the app remains responsive, with the clock continuing to tick whilst the simulated expensive computation is running asynchronously in a parallel process. Also the button is disabled and the plot greyed out until the computation is complete.

The call to daemons() is made at the top level, and onStop() may be used to automatically shut them down when the app exits.

library(shiny)
library(bslib)
library(mirai)

ui <- page_fluid(
  p("The time is ", textOutput("current_time", inline = TRUE)),
  hr(),
  numericInput("n", "Sample size (n)", 100),
  numericInput("delay", "Seconds to take for plot", 5),
  input_task_button("btn", "Plot uniform distribution"),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$current_time <- renderText({
    invalidateLater(1000)
    format(Sys.time(), "%H:%M:%S %p")
  })

  task <- ExtendedTask$new(
    function(...) mirai({Sys.sleep(y); runif(x)}, ...)
  ) |> bind_task_button("btn")

  observeEvent(input$btn, task$invoke(x = input$n, y = input$delay))

  output$plot <- renderPlot(hist(task$result()))

}

# run app using 1 local daemon
daemons(1)

# automatically shutdown daemons when app exits
onStop(function() daemons(0))

shinyApp(ui = ui, server = server)

Thanks to Joe Cheng for providing examples on which the above is based.

The key components to using ExtendedTask are:

  1. In the UI, use bslib::input_task_button(). This is a button which is disabled during computation to prevent additional clicks.
input_task_button("btn", "Plot uniform distribution")
  1. In the server, create an ExtendedTask object by calling ExtendedTask$new() on an anonymous function passing ... arguments to mirai(), and bind it to the button created in (1).
task <- ExtendedTask$new(
  function(...) mirai({Sys.sleep(y); runif(x)}, ...)
) |> bind_task_button("btn")
  1. In the server, create an observer on the input button, which invokes the ExtendedTask, passing in named arguments to the anonymous function (and hence the mirai) above.
observeEvent(input$btn, task$invoke(x = input$n, y = input$delay))
  1. In the server, create a render function for the output, which consumes the result of the ExtendedTask.
output$plot <- renderPlot(hist(task$result()))

Shiny ExtendedTask: Cancellation Example

The app below is a demonstration of the cancellation capability added in mirai v2.

It builds on the introductory app by adding a button that sends an infinite sleep extendedTask. This will block execution as we are using a single daemon - any new extendedTasks will be queued behind this never-ending task. There is also a button to cancel that blocking task and allow any queued plots to continue processing.

It works by assigning a reference to the mirai created in the extendedTask$new() method, which can then be passed to stop_mirai().

library(shiny)
library(bslib)
library(mirai)

ui <- page_fluid(
  p("The time is ", textOutput("current_time", inline = TRUE)),
  hr(),
  numericInput("n", "Sample size (n)", 100),
  numericInput("delay", "Seconds to take for plot", 5),
  input_task_button("btn", "Plot uniform distribution"),
  hr(),
  p("Click 'block' to suspend execution, and 'cancel' to resume"),
  input_task_button("block", "Block"),
  actionButton("cancel", "Cancel block"),
  hr(),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$current_time <- renderText({
    invalidateLater(1000)
    format(Sys.time(), "%H:%M:%S %p")
  })

  task <- ExtendedTask$new(
    function(...) mirai({Sys.sleep(y); runif(x)}, ...)
  ) |> bind_task_button("btn")

  m <- NULL
  block <- ExtendedTask$new(
    function() m <<- mirai(Sys.sleep(Inf))
  ) |> bind_task_button("block")

  observeEvent(input$btn, task$invoke(x = input$n, y = input$delay))
  observeEvent(input$block, block$invoke())
  observeEvent(input$cancel, stop_mirai(m))
  observe({
    updateActionButton(session, "cancel", disabled = block$status() != "running")
  })

  output$plot <- renderPlot(hist(task$result()))

}

# run app using 1 local daemon
daemons(1)

# automatically shutdown daemons when app exits
onStop(function() daemons(0))

shinyApp(ui = ui, server = server)

Thanks to Joe Cheng for providing examples on which the above is based.

Shiny ExtendedTask: Generative Art Example

The following app produces pretty spiral patterns.

The user can add multiple plots, making use of Shiny modules, each having a different calculation time.

The plots are generated asynchronously, and it is easy to see the practical limitations of the number of daemons set. For example, if updating 4 plots, and there are only 3 daemons, the 4th plot will not start to be generated until one of the other plots has finished.

By wrapping the runApp() call in with(daemons(...), ...) the daemons are set up for the duration of the app, exiting automatically when the app is stopped.

library(shiny)
library(mirai)
library(bslib)
library(ggplot2)
library(aRtsy)

# function definitions

run_task <- function(calc_time) {
  Sys.sleep(calc_time)
  list(
    colors = aRtsy::colorPalette(name = "random", n = 3),
    angle = runif(n = 1, min = - 2 * pi, max = 2 * pi),
    size = 1,
    p = 1
  )
}

plot_result <- function(result) {
  do.call(what = canvas_phyllotaxis, args = result)
}

# modules for individual plots

plotUI <- function(id, calc_time) {
  ns <- NS(id)
  card(
    strong(paste0("Plot (calc time = ", calc_time, " secs)")),
    input_task_button(ns("resample"), "Resample"),
    plotOutput(ns("plot"), height="400px", width="400px")
  )
}

plotServer <- function(id, calc_time) {
  force(id)
  force(calc_time)
  moduleServer(
    id,
    function(input, output, session) {

      task <- ExtendedTask$new(
        function(time, run) mirai(run(time), environment())
      ) |> bind_task_button("resample")

      observeEvent(input$resample, task$invoke(calc_time, run_task))

      output$plot <- renderPlot(plot_result(task$result()))

    }
  )
}

# ui and server

ui <- page_sidebar(fillable = FALSE,
  sidebar = sidebar(
    numericInput("calc_time", "Calculation time (secs)", 5),
    actionButton("add", "Add", class="btn-primary"),
  ),
  layout_column_wrap(id = "results", width = "400px", fillable = FALSE)
)

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

  observeEvent(input$add, {
    id <- nanonext::random(4)
    insertUI("#results", where = "beforeEnd", ui = plotUI(id, input$calc_time))
    plotServer(id, input$calc_time)
  })
}

app <- shinyApp(ui, server)

# run app using 3 local daemons
with(daemons(3), runApp(app))

The above example builds on original code by Joe Cheng, Daniel Woodie and William Landau.

The above uses environment() instead of ... as an alternative and equivalent way of passing variables present in the calling environment to the mirai.

The key components to using this ExtendedTask example are:

  1. In the UI, use bslib::input_task_button(). This is a button which is disabled during computation to prevent additional clicks.
input_task_button(ns("resample"), "Resample")
  1. In the server, create an ExtendedTask object by calling ExtendedTask$new() on an anonymous function passing named arguments to mirai(), and bind it to the button created in (1). These are passed through to the mirai by the use of environment().
task <- ExtendedTask$new(
  function(time, run) mirai(run(time), environment())
) |> bind_task_button("resample")
  1. In the server, create an observer on the input button, which invokes the ExtendedTask, supplying the arguments to the anonymous function above.
observeEvent(input$resample, task$invoke(calc_time, run_task))
  1. In the server, create a render function for the output, which consumes the result of the ExtendedTask.
output$plot <- renderPlot(plot_result(task$result()))

Advanced Promises Example: Coin Flips

The below example demonstrates how to integrate a mirai_map() operation into a Shiny app.

By specifying the ‘.promise’ argument, this registers a promise action against each mapped operation. These can then be used to update reactive values or otherwise interact with the Shiny app.

library(shiny)
library(mirai)

flip_coin <- function(...) {
  Sys.sleep(0.1)
  rbinom(n = 1, size = 1, prob = 0.501)
}

ui <- fluidPage(
  div("Is the coin fair?"),
  actionButton("task", "Flip 1000 coins"),
  textOutput("status"),
  textOutput("outcomes")
)

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

  # Keep running totals of heads, tails, and task errors
  flips <- reactiveValues(heads = 0, tails = 0, flips = 0)

  # Button to submit a batch of coin flips
  observeEvent(input$task, {
    flips$flips <- flips$flips + 1000
    mirai_map(
      1:1000,
      flip_coin,
      .promise = \(x) {
        if (x) flips$heads <- flips$heads + 1 else flips$tails <- flips$tails + 1
      }
    )
  })

  # Print time and task status
  output$status <- renderText({
    invalidateLater(millis = 1000)
    time <- format(Sys.time(), "%H:%M:%S")
    sprintf("%s | %s flips submitted", time, flips$flips)
  })

  # Print number of heads and tails
  output$outcomes <- renderText(
    sprintf("%s heads %s tails", flips$heads, flips$tails)
  )

}

app <- shinyApp(ui = ui, server = server)

# run app using 8 local non-dispatcher daemons (tasks are the same length)
with(daemons(8, dispatcher = FALSE), {
  # pre-load flip_coin function on all daemons for efficiency
  everywhere({}, flip_coin = flip_coin)
  runApp(app)
})

This is an adaptation of an original example provided by Will Landau for use of crew with Shiny. Please see https://wlandau.github.io/crew/articles/shiny.html.