2

I need some help with my Shiny app. I'll try to simplify my question. My problem is that a I'm developing an application that makes a report when a button is pressed. This report takes between 10 and 15 minutes. I would have another button (a 'Stop' button) that stops the previous process but doesn't stop my application. For ilustrate that, I'll show a simply code I can take as reference for resolve my app. I would like counting started by pressing at 'count' button, stops if I press 'stop' button.

ui.R code:

shinyUI(
   fluidPage(
   actionButton("count","Start count"),
   actionButton("stop","Stop count")
   )
)

server.R code:

shinyServer(function(input, output, session) {

   observeEvent(input$count, {

      observeEvent(input$stop, {
         # Code for stop counting
      })

      i <- 1
      for (i in i:10000) {
         print(paste("Number: ",i))
      }
   })
})

Thanks a lot friends!

Ir.
  • 21
  • 3
  • If your real code as a loop-structure then an easy solution is to check the state of a boolean variable at each iteration, and change this variable accordingly on your stop button. – Molx Jul 13 '15 at 14:21
  • I am afraid that state of the "stop" button changes only after calculation is ready. I have been also trying to figure out how to stop long calculation so for me this is really interesting question. – Mikael Jumppanen Jul 13 '15 at 15:03
  • This isn't really possible with Shiny. I've asked this question before too (http://stackoverflow.com/questions/30587883/is-it-possible-to-stop-executing-of-r-code-inside-shiny-without-stopping-the-sh and https://groups.google.com/forum/#!topic/shiny-discuss/j9-NeG9v5ds) , it's not supported – DeanAttali Jul 13 '15 at 18:11
  • @daattali thank you for your answer. I thought it could be possible with Shiny :( – Ir. Jul 13 '15 at 18:41
  • @MikaelJumppanen thank you so much! – Ir. Jul 13 '15 at 18:42
  • I think it's more of an R limitation than shiny – DeanAttali Jul 13 '15 at 18:46
  • I think this feature really should be supported in shiny and in R... – Mikael Jumppanen Jul 13 '15 at 19:01
  • I don't know how this would be achieved though. Essentially you want a way to stop the R process? It's my understanding that R is single threaded so when a computation starts, it's blocking and no other input is accepted. There isn't a "process" assigned to that computation that can be killed. – DeanAttali Jul 14 '15 at 08:24
  • @daattali you're right. I had forgotten R only can execute one process by time, parallel processing isn't allowed. Thank you so much! :) – Ir. Jul 15 '15 at 09:47

1 Answers1

0

I found a very nice solution here: https://www.r-bloggers.com/2018/07/long-running-tasks-with-shiny-challenges-and-solutions/

library(shiny)
library(promises)
library(future)
plan(multiprocess)

ui <- fluidPage(
  titlePanel("Long Run Stoppable Async"),
  sidebarLayout(
    sidebarPanel(
      actionButton('run', 'Run'),
      actionButton('cancel', 'Cancel'),
      actionButton('status', 'Check Status')
    ),
    mainPanel(
      tableOutput("result")
    )
  )
)

server <- function(input, output) {
  N <- 10
  
  # Status File
  status_file <- tempfile()
  
  get_status <- function(){
    scan(status_file, what = "character",sep="\n")
  }
  
  set_status <- function(msg){
    write(msg, status_file)
  }
  
  fire_interrupt <- function(){
    set_status("interrupt")
  }
  
  fire_ready <- function(){
    set_status("Ready")
  }
  
  fire_running <- function(perc_complete){
    if(missing(perc_complete))
      msg <- "Running..."
    else
      msg <- paste0("Running... ", perc_complete, "% Complete")
    set_status(msg)
  }
  
  interrupted <- function(){
    get_status() == "interrupt"
  }
  
  # Delete file at end of session
  onStop(function(){
    print(status_file)
    if(file.exists(status_file))
      unlink(status_file)
  })
  
  # Create Status File
  fire_ready()
  
  
  nclicks <- reactiveVal(0)
  result_val <- reactiveVal()
  observeEvent(input$run,{
    
    # Don't do anything if analysis is already being run
    if(nclicks() != 0){
      showNotification("Already running analysis")
      return(NULL)
    }
    
    # Increment clicks and prevent concurrent analyses
    nclicks(nclicks() + 1)
    
    result_val(data.frame(Status="Running..."))
    
    fire_running()
    
    result <- future({
      print("Running...")
      for(i in 1:N){
        
        # Long Running Task
        Sys.sleep(1)
        
        # Check for user interrupts
        if(interrupted()){ 
          print("Stopping...")
          stop("User Interrupt")
        }
        
        # Notify status file of progress
        fire_running(100*i/N)
      }
      
      #Some results
      quantile(rnorm(1000))
    }) %...>% result_val()
    
    # Catch inturrupt (or any other error) and notify user
    result <- catch(result,
                    function(e){
                      result_val(NULL)
                      print(e$message)
                      showNotification(e$message)
                    })
    
    # After the promise has been evaluated set nclicks to 0 to allow for anlother Run
    result <- finally(result,
                      function(){
                        fire_ready() 
                        nclicks(0)
                      })
    
    # Return something other than the promise so shiny remains responsive
    NULL
  })
  
  output$result <- renderTable({
    req(result_val())
  })
  
  # Register user interrupt
  observeEvent(input$cancel,{
    print("Cancel")
    fire_interrupt()
  })
  
  # Let user get analysis progress
  observeEvent(input$status,{
    print("Status")
    showNotification(get_status())
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
RRuiz
  • 2,159
  • 21
  • 32