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
.
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.
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.
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.
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)
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:
The revised app has two changes. First, it takes mirai
task returned by controller$push()
and turns 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)
)
)
The collect_flips()
function collects all the finished
flips and updates the flip counts.
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()
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)