mirai may be used as an asynchronous / distributed
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.
mirai may be used within Shiny’s ExtendedTask framework (in
shiny >= 1.8.1) to create scalable Shiny apps, which are
more responsive for a single user, as well as for multiple concurrent
users.
‘mirai’ are accepted anywhere a ‘promise’, ‘future’ or
‘future_promise’ is currently accepted (with promises >=
1.3.0).
In the example below, the app remains responsive, with the clock continuing to tick whilst the simulated expensive computation is running. Also the button is disabled and the plot greyed out until the computation is complete.
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(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")
})
extended_task <- ExtendedTask$new(
function(...) mirai({Sys.sleep(y); runif(x)}, ...)
) |> bind_task_button("btn")
observeEvent(input$btn, extended_task$invoke(x = input$n, y = input$delay))
output$plot <- renderPlot(hist(extended_task$result()))
}
app <- shinyApp(ui = ui, server = server)
# run app using 2 local daemons
with(daemons(2), runApp(app))Thanks to Joe Cheng for providing examples on which the above is based.
The key components to using ExtendedTask are:
bslib::input_task_button(). This is a
button which is disabled during computation to prevent additional
clicks.
input_task_button("btn", "Plot uniform distribution")ExtendedTask$new() on a function passing ...
arguments to mirai(), and bind it to the button created in
(1).
extended_task <- ExtendedTask$new(
function(...) mirai({Sys.sleep(y); runif(x)}, ...)
) |> bind_task_button("btn")
observeEvent(input$btn, extended_task$invoke(x = input$n, y = input$delay))
output$plot <- renderPlot(hist(extended_task$result()))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.
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) {
extended_task <- ExtendedTask$new(
function(...) mirai(run(x), ...)
) |> bind_task_button("resample")
observeEvent(input$resample, extended_task$invoke(x = calc_time, run = run_task))
output$plot <- renderPlot(plot_result(extended_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 key components to using this ExtendedTask example are:
bslib::input_task_button(). This is a
button which is disabled during computation to prevent additional
clicks.
input_task_button(ns("resample"), "Resample")ExtendedTask$new() on a function passing arguments to
mirai(), and bind it to the button created in (1). As not
all variables are supplied by inputs in this case, we make use of
environment() to conveniently pass in the calling
environment of the ExtendedTask function.
extended_task <- ExtendedTask$new(
function(x, run = run_task) mirai(run(x), environment())
) |> bind_task_button("resample")
observeEvent(input$resample, extended_task$invoke(calc_time))
output$plot <- renderPlot(plot_result(extended_task$result()))Whilst it is generally recommended to use the ExtendedTask framework, it is also possible for mirai to plug directly into Shiny’s reactive framework, without the use of ‘promises’ either implicitly or explicitly. This may be required for advanced uses of asynchronous programming, or where the use case does not fit the semantics of ExtendedTask.
The following is similar to the previous example, but allows multiple tasks to be submitted at once, rather than one after the other as required by ExtendedTask. There is a button to submit tasks, which will be processed by one of 3 daemons, outputting a pretty spiral pattern upon completion. If more than 3 tasks are submitted at once, the chart updates 3 at a time, limited by the number of available daemons.
It requires more boilerplate code to manage the mirai tasks, but otherwise functions similarly to the ExtendedTask example.
library(mirai)
library(shiny)
library(ggplot2)
library(aRtsy)
# function definitions
run_task <- function() {
Sys.sleep(5)
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)
}
status_message <- function(tasks) {
if (tasks == 0L) {
"All tasks completed."
} else {
sprintf("%d task%s in progress at %s", tasks, if (tasks > 1L) "s" else "", format.POSIXct(Sys.time()))
}
}
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.")
output$result <- renderPlot(reactive_result(), height = 600, width = 600)
output$status <- renderText(reactive_status())
poll_for_results <- reactiveVal(FALSE)
# create empty mirai queue
q <- list()
# button to submit a task
observeEvent(input$task, {
q[[length(q) + 1L]] <<- mirai(run_task(), run_task = run_task)
poll_for_results(TRUE)
})
# event loop to collect finished tasks
observe({
req(poll_for_results())
invalidateLater(millis = 250)
if (length(q)) {
if (!unresolved(q[[1L]])) {
reactive_result(plot_result(q[[1L]][["data"]]))
q[[1L]] <<- NULL
}
reactive_status(status_message(length(q)))
} else {
poll_for_results(FALSE)
}
})
}
app <- shinyApp(ui = ui, server = server)
# run app using 3 local daemons
with(daemons(3), runApp(app))Thanks to Daniel Woodie and William Landau for providing the original example on which this is based. Please see https://wlandau.github.io/crew/articles/shiny.html.