Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Concurrent, forked, cancellable tasks in Shiny
# Also uses parallel, shinyjs, tools
# Create a long-running task, executed in a forked process. (Doesn't work on Windows)
# The return value is a promise-like object with three
# methods:
# - completed(): FALSE initially, then TRUE if the task succeeds,
# fails, or is cancelled. Reactive, so when the state changes
# any reactive readers will invalidate.
# - result(): Use this to get the return value. While execution is
# in progress, performs a req(FALSE). If task succeeded, returns
# the return value. If failed, throws error. Reactive, so when
# the state changes any reactive readers will invalidate.
# - cancel(): Call this to prematurely terminate the task.
create_forked_task <- function(expr) {
state <- factor("running",
levels = c("running", "success", "error", "cancel"),
ordered = TRUE
result <- NULL
# Launch the task in a forked process. This always returns
# immediately, and we get back a handle we can use to monitor
# or kill the job.
task_handle <- parallel::mcparallel({
# Poll every 100 milliseconds until the job completes
o <- observe({
res <- parallel::mccollect(task_handle, wait = FALSE)
if (is.null(res)) {
} else {
if (!is.list(res) || length(res) != 1 || !inherits(res[[1]], "try-error")) {
state <<- "success"
result <<- res[[1]]
} else {
state <<- "error"
result <<- attr(res[[1]], "condition", exact = TRUE)
completed = function() {
state != "running"
result = function() {
if (state == "running") {
# If running, abort the current context silently.
# We've taken a reactive dependency on "state" so if
# the state changes the context will invalidate.
} else if (state == "success") {
} else if (state == "error") {
} else if (state == "cancel") {
validate(need(FALSE, "The operation was cancelled"))
cancel = function() {
if (state == "running") {
state <<- "cancel"
tools::pskill(task_handle$pid, tools::SIGTERM)
tools::pskill(-task_handle$pid, tools::SIGTERM)
parallel::mccollect(task_handle, wait = FALSE)
ui <- fluidPage(
shinyjs::useShinyjs(), # Initialize shinyjs library
# Buttons to control job
actionButton("start", "Start"),
shinyjs::disabled(actionButton("stop", "Stop")),
# This will display the job output
server <- function(input, output, session) {
# Make "task" behave like a reactive value
task <- NULL
output$out <- renderTable({
# The task starts out NULL but is required. The req() takes
# care of ensuring that we only proceed if it's non-NULL.
observeEvent(input$start, {
task <<- create_forked_task({
# Pretend this takes a long time
cars[sample(nrow(cars), 10),]
# Show progress message during task start
prog <- Progress$new(session)
prog$set(message = "Executing task, please wait...")
o <- observe({
# Only proceed when the task is completed (this could mean success,
# failure, or cancellation)
# This observer only runs once
# Close the progress indicator and update button state
observeEvent(input$stop, {
shinyApp(ui, server)
Copy link

abhijith-asok commented Dec 27, 2018

Hey! This method works great for my use and I have been stuck on it for a while. Thanks! I have a minor followup. I had a progress bar implemented for my Shiny dashboard in the reactive segment, which I lost when I had to implement the 'Cancel' feature using this method. I tried making 'expr' reactive, but it wouldn't pass it on into the function. I was trying to bring the progress bar back but since the way the method is called here is very different from regular Shiny practices, I can't seem to figure out a way. Would you have some guidance on how to implement a step-by-step progress bar for statements in 'expr' ? Thanks in Advance!

Copy link

dcaud commented Aug 29, 2021

I wonder if something in the IPC library would work -- for sharing info between processes.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment