stop a function in an asynchronous program

Hello,

I would like to know how to stop a function, an action in an asynchronous program with the future package that I retrieved on this post

i read the article proposed article proposed (part: Killing a long running process) and i add these elements in the code. But it don't work, the part future({...}) continues to run

inter <- AsyncInterruptor$new() 
inter$interrupt("Stop that future")
library(shiny)
library(ipc)
library(future)
plan(multiprocess)

calc <- function(i) {
  Sys.sleep(i)
}

ui <- shinyUI(fluidPage(
  titlePanel("Test update computation status flag"),
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(8,
               "Status:",
               textOutput("status1")
        ),
        column(4,
               "Box1"
        )
      ),
      hr(),
      fluidRow(
        column(8,
               "Status:",
               textOutput("status2")
        ),
        column(4,
               "Box2"
        )
      ),
      hr(),
      fluidRow(align = "center",
               actionButton("startButton", "START"),
               actionButton("stopButton", "STOP")
      )
    ),
    mainPanel()
  )
))

server <- shinyServer(function(input, output, session) {
  
  queue <- shinyQueue()
  queue$consumer$start(100) # Execute signals every 100 milliseconds
  
  stat1 <- reactiveVal(NULL)
  stat2 <- reactiveVal(NULL)
  fut   <- NULL
  
  inter <- AsyncInterruptor$new()
  observeEvent(input$startButton, {
    fut <<- future({
      inter$execInterrupts()
      for(i in 1:2) {
        queue$producer$fireAssignReactive(paste0("stat",i), "queue")
      }
      for(i in 1:2) {
        queue$producer$fireAssignReactive(paste0("stat",i), "running")
        calc(5)
        queue$producer$fireAssignReactive(paste0("stat",i), "done")
      }
    })
    #Return something other than the future so we don't block the UI
    NULL
  })
  
  observeEvent(input$stopButton, {
    inter$interrupt("Stop that future")
    stat1("cancel")
    stat2("cancel")
  })
  
  
  output$status1 <- renderText(stat1())
  output$status2 <- renderText(stat2())
})

shinyApp(ui = ui, server = server)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.