About
crew is efficient to use in Shiny apps, and the centralized
controller makes the programming easy, even if there are thousands
of tasks.
This vignette shows two versions of an example app. The first version
is simple to code but choppily. The second version feels snappier
because it uses integration between promises and
mirai.
Example: coin flips, no promises
This app simulates thousands of coin flips to determine if a coin is
fair. Each coin flip is a task, and crew runs the tasks in
parallel. When you run the app, the clock keeps ticking even while coin
flips are running. In other words, parallel tasks run in the background
and the app stays interactive.
Tutorial
We first load Shiny.
The flip_coin() function simulates a coin flip: wait 0.1
seconds, then randomly return 1 for heads or 0 for tails. After many
flips, the user may deduce that the coin is slightly unfair.
The UI has a button to flip coins and a text output for results.
ui <- fluidPage(
div("Is the coin fair?"),
actionButton("button", "Flip 1000 coins"),
textOutput("results")
)In the server, we start by creating a crew controller
which will simulate coin flips in parallel across 10 parallel workers.
seconds_idle = 10 means each worker automatically exits if
it idles for 10 seconds.
server <- function(input, output, session) {
controller <- crew::crew_controller_local(workers = 10, seconds_idle = 10)
controller$start()
onStop(function() controller$terminate())We keep running totals of heads, tails, and total flips.
flips <- reactiveValues(heads = 0, tails = 0, total = 0)The action button submits a batch of 1000 coin flips.
observeEvent(input$button, {
controller$walk(
command = flip_coin(),
iterate = list(index = seq_len(1000)),
data = list(flip_coin = flip_coin)
)
})We include an observe() statement to watch for finished
coin flips and update the totals every 0.5 seconds.
observe({
invalidateLater(millis = 500)
results <- controller$collect(error = "stop")
req(results)
new_flips <- as.logical(results$result)
flips$heads <- flips$heads + sum(new_flips)
flips$tails <- flips$tails + sum(1 - new_flips)
flips$total <- flips$total + length(new_flips)
})Finally, our text output refreshes every 0.5 seconds to update the clock and the totals.
A text output refreshes to show the current time and the number of coin flips submitted but not yet completed. The refresh happens when a batch of coin flips is submitted, a coin flip completes, or a full second has passed.
Full app code
library(shiny)
flip_coin <- function() {
Sys.sleep(0.1)
rbinom(n = 1, size = 1, prob = 0.55)
}
ui <- fluidPage(
div("Is the coin fair?"),
actionButton("button", "Flip 1000 coins"),
textOutput("results")
)
server <- function(input, output, session) {
# crew controller
controller <- crew::crew_controller_local(workers = 10, seconds_idle = 10)
controller$start()
onStop(function() controller$terminate())
# Keep running totals of heads, tails, and total flips.
flips <- reactiveValues(heads = 0, tails = 0, total = 0)
# Flip a batch of coins when the button is pressed.
observeEvent(input$button, {
controller$walk(
command = flip_coin(),
iterate = list(index = seq_len(1000)),
data = list(flip_coin = flip_coin)
)
})
# Collect coin flip results.
observe({
invalidateLater(millis = 500)
results <- controller$collect(error = "stop")
req(results)
new_flips <- as.logical(results$result)
flips$heads <- flips$heads + sum(new_flips)
flips$tails <- flips$tails + sum(1 - new_flips)
flips$total <- flips$total + length(new_flips)
})
# Print time and flip counts.
output$results <- renderText({
invalidateLater(millis = 500)
pattern <- "%s | %s heads, %s tails, %s total"
time <- format(Sys.time(), "%H:%M:%S")
sprintf(pattern, time, flips$heads, flips$tails, flips$total)
})
}
shinyApp(ui = ui, server = server)Example: coin flips, with promises
The previous app feels choppy because it only refreshes every half
second. Using the powerful integration between promises and
mirai, we can make
the UI respond as soon as a task finishes. Watch the video below to see
the difference:
Tutorial
The revised app has three changes. First, we need an unobtrusive
background loop to auto-scale crew workers. To enable this,
we call controller$autoscale() just after
start().
controller$start()
controller$autoscale()
onStop(function() controller$terminate())Second, we take the mirai task returned by
controller$push() and turn it into a special promise.
This promise
updates the coin flip counts as soon as the flip finishes.
observeEvent(
input$button,
replicate(
1000,
controller$push(flip_coin(), data = list(flip_coin = flip_coin)) %...>%
collect_flips(controller, flips)
)
)Finally, the collect_flips() function collects all the
finished flips and updates the flip counts.
Full app code
library(promises)
library(shiny)
flip_coin <- function() {
Sys.sleep(0.1)
rbinom(n = 1, size = 1, prob = 0.55)
}
collect_flips <- function(ignore, controller, flips) {
new_flips <- as.integer(controller$collect(error = "stop")$result)
if (!length(new_flips)) return()
flips$heads <- flips$heads + sum(new_flips)
flips$tails <- flips$tails + sum(1 - new_flips)
flips$total <- flips$total + length(new_flips)
}
ui <- fluidPage(
div("Is the coin fair?"),
actionButton("button", "Flip 1000 coins"),
textOutput("results")
)
server <- function(input, output, session) {
# crew controller
controller <- crew::crew_controller_local(workers = 10, seconds_idle = 10)
controller$start()
controller$autoscale()
onStop(function() controller$terminate())
# Keep running totals of heads, tails, and total flips.
flips <- reactiveValues(heads = 0, tails = 0, total = 0)
# Flip a batch of coins when the button is pressed.
observeEvent(
input$button,
replicate(
1000,
controller$push(flip_coin(), data = list(flip_coin = flip_coin)) %...>%
collect_flips(controller, flips)
)
)
# Print time and flip counts.
output$results <- renderText({
invalidateLater(millis = 500)
pattern <- "%s | %s heads, %s tails, %s total"
time <- format(Sys.time(), "%H:%M:%S")
sprintf(pattern, time, flips$heads, flips$tails, flips$total)
})
}
shinyApp(ui = ui, server = server)