title: stopping a process in shiny by a user and providing responsiveness during computations
body: <p>I'm using a function from the <code>ClusterProfiler</code> package, which takes 0.1-10 min to complete. I'd like to keep shiny responsive during the computation, and also give a possibility to terminate the execution. This is the computation only:</p>
  
  <pre><code>library(org.Mm.eg.db)
  library(clusterProfiler)
  d &lt;-
    data.frame(
      ENTREZ = c(
        "26394",
        "16765",
        "19143",
        "54214",
        "620695",
        "14232",
        "20262",
        "100732",
        "99681"
      ),
      Cell_Type = c(rep("A", 5), rep("B", 4)),
      Timepoint = rep("C", 9)
    )
  
  r &lt;- compareCluster(
    ENTREZ ~ Cell_Type + Timepoint,
    data = d,
    fun = "enrichGO",
    pvalueCutoff = 0.5,
    qvalueCutoff = 0.5,
    ont           = "MF",
    pAdjustMethod = "BH",
    readable = T,
    OrgDb         = org.Mm.eg.db,
    keyType       = 'ENTREZID'
  )
  
    rp &lt;- dotplot(r, showCategory=10, x = ~Cell_Type) +
      facet_wrap(~Timepoint)
  rp
  </code></pre>
  
  <p>The best solution I found for that was a neat script from the user fxi (<a href="https://stackoverflow.com/a/34517844/9950389">https://stackoverflow.com/a/34517844/9950389</a>). However, I run into a problem. The function <code>analyze</code> executed in the script as a parallel process, seems to return an improper object type for the downstream function, in this case <code>dotplot</code> (<code>unable to find an inherited method for function ‘dotplot’ for signature ‘"list"’</code>). Below there is a minimal example of the problem (shamelessly based on the script written by the user fxi). Do you see any solution to this?</p>
  
  <pre><code>library(shiny)
  library(parallel)
  library(org.Mm.eg.db)
  library(clusterProfiler)
  
  #
  # reactive variables
  # 
  rVal &lt;- reactiveValues()
  rVal$process &lt;- NULL
  rVal$msg &lt;- NULL
  rVal$obs &lt;- NULL
  counter &lt;- 0
  results &lt;- list()
  dfEmpty &lt;- data.frame(results = numeric(0))
  
  
  #
  # Long computation
  #
  analyze &lt;- function() {
    d &lt;-
      data.frame(
        ENTREZ = c(
          "26394",
          "16765",
          "19143",
          "54214",
          "620695",
          "14232",
          "20262",
          "100732",
          "99681"
        ),
        Cell_Type = c(rep("A", 5), rep("B", 4)),
        Timepoint = rep("C", 9)
      )
  
    r &lt;- compareCluster(
      ENTREZ ~ Cell_Type + Timepoint,
      data = d,
      fun = "enrichGO",
      pvalueCutoff = 0.5,
      qvalueCutoff = 0.5,
      ont           = "MF",
      pAdjustMethod = "BH",
      readable = T,
      OrgDb         = org.Mm.eg.db,
      keyType       = 'ENTREZID'
    )
  }
  
  #
  # Shiny app
  #
  shinyApp(
    ui = fluidPage(
      column(6,
             wellPanel(
               tags$label("Press start and wait 5 seconds for the process to finish"),
               actionButton("start", "Start", class = "btn-primary"),
               actionButton("stop", "Stop", class = "btn-danger"),
               textOutput('msg'),
               plotOutput('myplot', width = 200)
             )
      ),
      column(6,
             wellPanel(
               sliderInput(
                 "inputTest",
                 "Shiny is responsive during computation",
                 min = 10,
                 max = 100,
                 value = 40
               ),
               plotOutput("testPlot")
             ))),
    server = function(input, output, session)
    {
      #
      # Add something to play with during waiting
      #
      output$testPlot &lt;- renderPlot({
        plot(rnorm(input$inputTest))
      })
  
      #
      # Render messages
      #
      output$msg &lt;- renderText({
        rVal$msg
      })
  
      #
      # Render results
      #
      # output$result &lt;- renderTable({
      #   print(rVal$result)
      #   rVal$result
      # })
  
      output$myplot &lt;-renderPlot({
        r &lt;- rVal$result
        rp &lt;- dotplot(r, showCategory=10, x = ~Cell_Type) +
          facet_wrap(~Timepoint) +
          scale_color_gradient(low = "lawngreen", high = "black") +
          guides(color=guide_colorbar(title = "Adj. P-value")) +
          theme(title = element_text(size = 16, face = "plain", lineheight = .8),
                panel.grid.major.x = element_blank(),
                panel.grid.major.y = element_line(size = 0.1),
                axis.title = element_text(size = 16),
                text = element_text(size = 14),
                strip.text.x = element_text(size = 18, face = "plain"),
                axis.text = element_text(size = 14, face = "plain"),
                legend.text = element_text(angle = 0, hjust=0, size = 16),
                legend.title.align = 0.5,
                legend.title = element_text(angle = 0, hjust=0, size = 18)) +
          coord_fixed(ratio = 0.4)
        rp
      })
  
  
      #
      # Start the process
      #
      observeEvent(input$start, {
        if (!is.null(rVal$process))
          return(NULL)
        rVal$result &lt;- NULL
        rVal$process &lt;- mcparallel({
          analyze()
        })
  
        rVal$msg &lt;- sprintf("%1$s started", rVal$process$pid)
  
      })
  
  
      #
      # Stop the process
      #
      observeEvent(input$stop, {
        rVal$result &lt;- NULL
        if (!is.null(rVal$process)) {
          tools::pskill(rVal$process$pid)
          rVal$msg &lt;- sprintf("%1$s killed", rVal$process$pid)
          rVal$process &lt;- NULL
  
          if (!is.null(rVal$obs)) {
            rVal$obs$destroy()
          }
        }
      })
  
  
      #
      # Handle process event
      #
      observeEvent(rVal$process, {
        rVal$obs &lt;- observe({
          invalidateLater(500, session)
          isolate({
            result &lt;- mccollect(rVal$process, wait = FALSE)
            if (!is.null(result)) {
              rVal$result &lt;- result
              rVal$obs$destroy()
              rVal$process &lt;- NULL
            }
          })
        })
      }) # observe
    }
  )
  </code></pre>
  
  <p>I also tried using the async approach, but both attempts failed:</p>
  
  <pre><code>library(promises)
  library(future)
  
  future(
      compareCluster(
        ENTREZ ~ Cell_Type + Timepoint,
        data = d,
        fun = "enrichGO",
        pvalueCutoff = 0.5,
        qvalueCutoff = 0.5,
        ont           = "MF",
        pAdjustMethod = "BH",
        readable = T,
        OrgDb         = org.Mm.eg.db,
        keyType       = 'ENTREZID'
      )
    ) %...&gt;% dotplot(., showCategory=10, x = ~Cell_Type) +
      facet_wrap(~Timepoint)
  
  
  future(
    compareCluster(
      ENTREZ ~ Cell_Type + Timepoint,
      data = d,
      fun = "enrichGO",
      pvalueCutoff = 0.5,
      qvalueCutoff = 0.5,
      ont           = "MF",
      pAdjustMethod = "BH",
      readable = T,
      OrgDb         = org.Mm.eg.db,
      keyType       = 'ENTREZID'
    )
  ) %...&gt;% {
    dotplot(., showCategory=10, x = ~Cell_Type) +
    facet_wrap(~Timepoint)
    }
  </code></pre>