Interrupting a background process

Jun 13, 2018 · 2 min read · R shiny ·

I had been running a shiny app in which I could halt a long-running process. The process would update the shiny app and constantly looked for an updated shiny variable to inform if a cancel button had been pressed. The code had been adapted from a SO post at https://stackoverflow.com/questions/30587883/is-it-possible-to-stop-executing-of-r-code-inside-shiny-without-stopping-the-sh/34517844#34517844. Unfortunately this utilized the httpuv::service function in a manner for which it was not designed. At some point, when shiny and httpuv were updated, this functionality ceased to work. Thanks to some help from Joe Cheng a similar functionality can be derived using an asynchronous function. A working example is shown below.

 1library(shiny)
 2
 3ui <- fluidPage(
 4  actionButton("start_list", "Start 'list' iterator"),
 5  actionButton("start_list2", "Start reactive 'list' iterator"),
 6  actionButton("start_while", "Start 'while' iterator"),
 7  actionButton("cancel", "Stop")
 8)
 9
10server <- function(input, output, session) {
11  
12  val <- reactiveValues(b = 100)
13  
14  
15  base_task_iterator <- function(should_continue, iter_body) {
16    if (should_continue()) {
17      iter_body()
18      later::later(~base_task_iterator(should_continue, iter_body))
19    }
20    invisible()
21  }
22  
23  while_task_iterator <- function(cancelExpr, whileExpr, func) {
24      cancelFunc <- rlang::as_function(rlang::enquo(cancelExpr))
25      whileFunc <- rlang::as_function(rlang::enquo(whileExpr))
26      
27      origCancelVal <- isolate(try(silent = TRUE, cancelFunc()))
28      cancelled <- function() {
29        !identical(origCancelVal, isolate(try(silent = TRUE, cancelFunc())))
30      }
31      
32        base_task_iterator(
33        function() {
34          !cancelled() && whileFunc()
35        },
36        func
37      )
38  }
39  
40  list_task_iterator <- function(cancelExpr, x, func) {
41      cancelExpr <- rlang::enquo(cancelExpr)
42      
43      origCancelVal <- isolate(try(silent = TRUE, cancelFunc()))
44      pos <- 1
45      
46        while_task_iterator(!!cancelExpr, pos <= length(x), function() {
47        i <- pos
48        pos <<- pos + 1L
49        isolate({
50          func(x[[i]])
51      })
52    })
53  }
54  
55  observeEvent(input$start_list, {
56    list_task_iterator(input$cancel, 1:10, function(x) {
57      message(x)
58      Sys.sleep(1)
59    })
60  })
61  
62  observeEvent(input$start_list2, {
63    list_task_iterator(input$cancel, 1:10, function(x) {
64      val$b <- val$b + 1
65      message(val$b)
66      Sys.sleep(1)
67    })
68  })
69  
70  observeEvent(input$start_while, {
71    # Something's wrong with rlang::as_function, I can't use TRUE, only !FALSE
72    while_task_iterator(input$cancel, !FALSE, function() {
73      message(format(Sys.time()))
74      Sys.sleep(1)
75    })
76  })
77}
78
79shinyApp(ui, server)