add create forked task

Rfunctions/Data_Management.R

 #@ This file contains all the functions needed to
 #@ to load, check, filter and transform the data 
 
+create_forked_task <- function(expr) {
+  makeReactiveBinding("state")
+  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({
+    force(expr)
+  })
+  
+  # Poll every 100 milliseconds until the job completes
+  o <- observe({
+    res <- parallel::mccollect(task_handle, wait = FALSE)
+    if (is.null(res)) {
+      invalidateLater(100)
+    } else {
+      o$destroy()
+      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)
+      }
+    }
+  })
+  
+  list(
+    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.
+        req(FALSE)
+      } else if (state == "success") {
+        return(result)
+      } else if (state == "error") {
+        stop(result)
+      } else if (state == "cancel") {
+        validate(need(FALSE, "The operation was cancelled"))
+      }
+    },
+    cancel = function() {
+      if (state == "running") {
+        state <<- "cancel"
+        o$destroy()
+        tools::pskill(task_handle$pid, tools::SIGTERM)
+        tools::pskill(-task_handle$pid, tools::SIGTERM)
+        parallel::mccollect(task_handle, wait = FALSE)
+      }
+    }
+  )
+}
+
+
 ## Add news to the home page
 addNews <- function(date ="",title="",text="")
 {
@@ -509,9 +573,7 @@ GetCountsMerge <- function(input,dataInput,taxoSelect,target,design)
     
     ## Create the dds object
     dds <- DESeqDataSetFromMatrix(countData=CT, colData=target, design=design,ignoreRank=TRUE)
-  
-    print(head(CT))
-    print(GeoMeansCT(CT))
+
     #save(dds,file="testdds.RData")
     if(is.null(VarNorm)){
       ## Counts normalisation

server.R

@@ -2059,7 +2059,7 @@ shinyServer(function(input, output,session) {
     if(!is.null(resDiff))
     { 
       ## Check the R version
-       if(as.numeric(R.Version()$major)<=3 && as.numeric(R.Version()$minor) <=1.2){
+       # if(as.numeric(R.Version()$major)<=3 && as.numeric(R.Version()$minor) <=1.2){
         box(title="Contrasts (New)",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = FALSE,
             fluidRow(
               column(width=3,selectInput("Select1_contrast","Compare","")),
@@ -2068,7 +2068,7 @@ shinyServer(function(input, output,session) {
               column(width=3,br(),actionButton("AddContrastEasy","Add",icon = icon("plus")))
             )
         )
-      }
+      # }
     }
     
     
@@ -2284,7 +2284,7 @@ shinyServer(function(input, output,session) {
   
   ## Run DESeq2 via RunDESeq button
   observeEvent(input$RunDESeq,{
-    ResDiffAnal()
+    create_forked_task(ResDiffAnal())
   })
     
   

ui.R

@@ -13,7 +13,7 @@ sidebar <- dashboardSidebar(
       menuItem("Home", tabName = "Home", icon = icon("home")),
       menuItem("Tutorial", tabName = "Tutorial", icon = icon("book")),
       menuItem("Download/Install", tabName = "Download", icon = icon("download")),
-      menuItem("Raw data", tabName = "RawData", icon = icon("upload")),
+      #menuItem("Raw data", tabName = "RawData", icon = icon("upload")),
       menuItem("Upload your data", tabName = "Upload", icon = icon("upload")),
       # bookmarkButton(),
       menuItemOutput("dymMenu"),