Session id for res_tmp, par_tmp

program/shinyApp/R/enrichment_analysis/server.R

@@ -424,7 +424,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){
       )
       # refresh the UI/data if needed
       observeEvent(input$refreshUI, {
-        ea_reactives$data <- update_data(data, 0, 0)$data
+        ea_reactives$data <- update_data(session$token)$data
       })
       # UI to choose test correction
       output$AdjustmentMethod_ui <- renderUI({
@@ -804,9 +804,9 @@ enrichment_analysis_Server <- function(id, data, params, updates){
           }
           ea_reactives$ea_info <- "**Enrichment Analysis Done!**"
           # res_temp Zuweisung
-          res_tmp["Enrichment"] <<- ea_reactives$enrichment_results
+          res_tmp[[session$token]]["Enrichment"] <<- ea_reactives$enrichment_results
           # par_temp Zuweisung
-          par_tmp["Enrichment"] <<- list(
+          par_tmp[[session$token]]["Enrichment"] <<- list(
             "ValueToAttach" = input$ValueToAttach,
             "GeneSet2Enrich" = input$GeneSet2Enrich,
             "Groups2Compare_ref_GSEA" = input$Groups2Compare_ref_GSEA,

program/shinyApp/R/heatmap/server.R

@@ -220,7 +220,7 @@ heatmap_server <- function(id, data, params, updates){
         )
         req(selectedData_processed())
         # update the data if needed
-        data <- update_data(data, updates, heatmap_reactives$current_updates)
+        data <- update_data(session$token)
         heatmap_reactives$current_updates <- updates()
         print("Heatmap on selected Data")
         # Value need to be setted in case there is nothing to plot to avoid crash
@@ -360,7 +360,6 @@ heatmap_server <- function(id, data, params, updates){
         }
         if(calculate == 1){
           if(input$LFC_toHeatmap){
-            browser()
             ctrl_samples_idx <- which(
               colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_ref_heatmap
               )
@@ -372,7 +371,7 @@ heatmap_server <- function(id, data, params, updates){
               output$Options_selected_out_3 <- renderText("Choose variable with at least two samples per condition!")
               doThis_flag <- F
             }
-            if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"|
+            if(par_tmp[[session$token]]$PreProcessing_Procedure == "simpleCenterScaling"|
                any(assay(data$data))< 0){
 
               print("Remember do not use normal center + scaling (negative Values!)")
@@ -453,15 +452,15 @@ heatmap_server <- function(id, data, params, updates){
         } else {
           print("Plotting saved result")
           if(input$LFC_toHeatmap){
-            myBreaks <- c(seq(min(res_tmp$Heatmap$LFC), 0, length.out=ceiling(paletteLength/2) + 1),
-                            seq(max(res_tmp$Heatmap$LFC)/paletteLength, max(res_tmp$Heatmap$LFC), length.out=floor(paletteLength/2)))
+            myBreaks <- c(seq(min(res_tmp[[session$token]]$Heatmap$LFC), 0, length.out=ceiling(paletteLength/2) + 1),
+                            seq(max(res_tmp[[session$token]]$Heatmap$LFC)/paletteLength, max(res_tmp[[session$token]]$Heatmap$LFC), length.out=floor(paletteLength/2)))
             annotation_col <- rowData(data2Plot)[,input$row_anno_options,drop=F]
 
             scenario <- 10
             heatmap_plot <- pheatmap(
-                t(res_tmp$Heatmap[,"LFC",drop=F]),
+                t(res_tmp[[session$token]]$Heatmap[,"LFC",drop=F]),
                 main = gsub("^Heatmap","Heatmap_LFC",customTitleHeatmap),
-                show_rownames = ifelse(nrow(res_tmp$Heatmap)<=25,TRUE,FALSE),
+                show_rownames = ifelse(nrow(res_tmp[[session$token]]$Heatmap)<=25,TRUE,FALSE),
                 show_colnames = TRUE,
                 cluster_cols = input$cluster_cols,
                 cluster_rows = FALSE,
@@ -472,12 +471,12 @@ heatmap_server <- function(id, data, params, updates){
                 color = myColor_fill
               )
           } else {
-            clusterRowspossible <- ifelse(nrow(as.matrix(res_tmp$Heatmap))>1,input$cluster_rows,F)
-            if(any(is.na(res_tmp$Heatmap))){
-              idx_of_nas <- which(apply(res_tmp$Heatmap,1,is.na)) # why do we produce Nas?
+            clusterRowspossible <- ifelse(nrow(as.matrix(res_tmp[[session$token]]$Heatmap))>1,input$cluster_rows,F)
+            if(any(is.na(res_tmp[[session$token]]$Heatmap))){
+              idx_of_nas <- which(apply(res_tmp[[session$token]]$Heatmap,1,is.na)) # why do we produce Nas?
               print(idx_of_nas)
               if(length(idx_of_nas)>0){
-                res_tmp$Heatmap <- res_tmp$Heatmap[-idx_of_nas,]
+                res_tmp[[session$token]]$Heatmap <- res_tmp[[session$token]]$Heatmap[-idx_of_nas,]
               }
 
               annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F]
@@ -494,9 +493,9 @@ heatmap_server <- function(id, data, params, updates){
             }
             scenario <- 11
             heatmap_plot <- pheatmap(
-              as.matrix(res_tmp$Heatmap),
+              as.matrix(res_tmp[[session$token]]$Heatmap),
               main = customTitleHeatmap,
-              show_rownames = ifelse(nrow(res_tmp$Heatmap)<=input$row_label_no,TRUE,FALSE),
+              show_rownames = ifelse(nrow(res_tmp[[session$token]]$Heatmap)<=input$row_label_no,TRUE,FALSE),
               labels_row = rowData(data$data)[rownames(data2HandOver),input$row_label_options],
               show_colnames = TRUE,
               cluster_cols = input$cluster_cols,
@@ -531,27 +530,27 @@ heatmap_server <- function(id, data, params, updates){
         # Heatmap_Groups2Compare_ctrl_heatmap <- input$Groups2Compare_ctrl_heatmap
 
 
-        # res_tmp gets data2HandOver or Data2Plot depending on scenario
+        # res_tmp[[session$token]] gets data2HandOver or Data2Plot depending on scenario
         if(scenario == 10){
-          res_tmp[["Heatmap"]] <<- Data2Plot
+          res_tmp[[session$token]][["Heatmap"]] <<- Data2Plot
         }else if(scenario == 11){
-          res_tmp[["Heatmap"]] <<- data2HandOver
+          res_tmp[[session$token]][["Heatmap"]] <<- data2HandOver
         }
-        # par_tmp gets the parameters used for the heatmap
+        # par_tmp[[session$token]] gets the parameters used for the heatmap
         ## This exports all reactive Values in the PCA namespace 
         tmp <- getUserReactiveValues(input)
-        par_tmp$Heatmap[names(tmp)] <<- tmp
+        par_tmp[[session$token]]$Heatmap[names(tmp)] <<- tmp
 
 
         output$getR_Code_Heatmap <- downloadHandler(
           filename = function(){
-            paste("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip", sep = "")
+            paste0("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip")
           },
           content = function(file){
-            envList=list(
-
-              res_tmp=res_tmp,
-              par_tmp=par_tmp
+            # TODO: I think these are the completely wrong objects to save here. Needs Check!
+            envList <- list(
+              res_tmp = res_tmp[[session$token]],
+              par_tmp = par_tmp[[session$token]]
             )
 
             temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
@@ -572,16 +571,16 @@ heatmap_server <- function(id, data, params, updates){
         )
 
         output$SavePlot_Heatmap <- downloadHandler(
-          filename = function() { 
-            paste(Heatmap_customTitleHeatmap, " ",Sys.time(),input$file_ext_Heatmap,sep="") 
+          filename = function() {
+            paste0(Heatmap_customTitleHeatmap, " ", Sys.time(), input$file_ext_Heatmap)
             },
           content = function(file){
             save_pheatmap(heatmap_plot,filename=file,type=gsub("\\.","",input$file_ext_Heatmap))
             on.exit({
               tmp_filename <- paste0(
                 getwd(),
                 "/www/",
-                paste(paste(Heatmap_customTitleHeatmap, " ",Sys.time(),input$file_ext_Heatmap,sep=""))
+                paste0(Heatmap_customTitleHeatmap, " ", Sys.time(), input$file_ext_Heatmap)
                 )
               save_pheatmap(
                 heatmap_plot,
@@ -620,8 +619,8 @@ heatmap_server <- function(id, data, params, updates){
         )
 
         output$SaveGeneList_Heatmap <- downloadHandler(
-          filename = function() { 
-            paste("GeneList_",customTitleHeatmap, " ",Sys.time(),".csv",sep="")
+          filename = function() {
+            paste0("GeneList_", customTitleHeatmap, " ", Sys.time(), ".csv")
             },
 
           content = function(file){

program/shinyApp/R/pca/server.R

@@ -193,7 +193,7 @@ pca_Server <- function(id, data, params, row_select, updates){
         if(pca_reactives$calculate >= 0){
           # update the data if needed
           # TODO check if the follwoing still needed as update is now done on 1st server level
-          data2plot <- update_data(data, updates, pca_reactives$current_updates)
+          data2plot <- update_data(session$token)
           # select the neccesary data
           if(input$data_selection_pca){
             data2plot <- select_data(
@@ -324,9 +324,9 @@ pca_Server <- function(id, data, params, row_select, updates){
           pca_reactives$df_loadings <- df_loadings
 
           # assign res_temp
-          res_tmp[["PCA"]] <<- list(pca)
+          res_tmp[[session$token]][["PCA"]] <<- list(pca)
           # assign par_temp as empty list
-          par_tmp[["PCA"]] <<- list(
+          par_tmp[[session$token]][["PCA"]] <<- list(
             # add a dummy parameter to avoid error
             dummy = "dummy",
             sample_selection_pca = input$sample_selection_pca,

program/shinyApp/R/pca/util.R

@@ -1,9 +1,9 @@
 check_calculations <- function(current_parameters, module){
-  if (is.null(res_tmp[[module]])){  # chec whether result is existent
+  if (is.null(res_tmp[[session$token]][[module]])){  # chec whether result is existent
     return("No Result yet")
   }
   # check whether all parameters are identical to the current existing result
-  if (identical(par_tmp[[module]], current_parameters)){
+  if (identical(par_tmp[[session$token]][[module]], current_parameters)){
     return("Result exists")
   }
   # The remaining case is an existing result with other parameters,

program/shinyApp/R/sample_correlation/server.R

@@ -40,7 +40,7 @@ sample_correlation_server <- function(id, data, params, updates){
 
         if(sample_corr_reactive$calculate == 1){
           # update the data if needed
-          data <- update_data(data, updates, sample_corr_reactive$current_updates)
+          data <- update_data(session$token)
           sample_corr_reactive$current_updates <- updates()
           # set the counter to 0 to prevent any further plotting
           sample_corr_reactive$calculate <- 0
@@ -53,7 +53,7 @@ sample_correlation_server <- function(id, data, params, updates){
               data_info = list(
                 rows = length(rownames(data$data)),
                 cols = length(colnames(data$data)),
-                preprocessing = par_tmp$PreProcessing_Procedure
+                preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure
               )
             ),
             "SampleCorrelation"
@@ -70,7 +70,7 @@ sample_correlation_server <- function(id, data, params, updates){
             output$SampleCorr_Info <- renderText(
               "Correlation Matrix was already computed, no need to click the Button again."
             )
-            cormat <- res_tmp$SampleCorrelation
+            cormat <- res_tmp[[session$token]]$SampleCorrelation
           } else if (check == "Overwrite"){
             output$SampleCorr_Info <- renderText(
               "Correlation Matrix result overwritten with different parameters."
@@ -122,14 +122,14 @@ sample_correlation_server <- function(id, data, params, updates){
             annotation_colors = anno_colors
             )
           # assign res_temp["SampleCorrelation"]
-          res_tmp[["SampleCorrelation"]] <<- cormat
+          res_tmp[[session$token]][["SampleCorrelation"]] <<- cormat
           # assign par_temp["SampleCorrelation"]
-          par_tmp[["SampleCorrelation"]] <<- list(
+          par_tmp[[session$token]][["SampleCorrelation"]] <<- list(
             corrMethod = input$corrMethod,
             data_info = list(
               rows = length(rownames(data$data)),
               cols = length(colnames(data$data)),
-              preprocessing = par_tmp$PreProcessing_Procedure
+              preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure
             )
           )
 
@@ -141,7 +141,7 @@ sample_correlation_server <- function(id, data, params, updates){
             customTitleSampleCorrelation <- "SampleCorrelation"
           }
 
-          par_tmp[["SampleCorr"]] <<- list(
+          par_tmp[[session$token]][["SampleCorr"]] <<- list(
             customTitleSampleCorrelation = customTitleSampleCorrelation,
             SampleCorrelationPlot_final = SampleCorrelationPlot_final,
             cormat = cormat,
@@ -161,16 +161,16 @@ sample_correlation_server <- function(id, data, params, updates){
         },
         content = function(file){
           envList = list(
-            cormat = ifelse(exists("cormat"),par_tmp[["SampleCorr"]]$cormat,NA),
-            annotationDF = ifelse(exists("annotationDF"),par_tmp[["SampleCorr"]]$annotationDF,NA),
-            customTitleSampleCorrelation = ifelse(exists("customTitleSampleCorrelation"),par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,NA),
-            anno_colors = ifelse(exists("anno_colors"),par_tmp[["SampleCorr"]]$anno_colors,NA)
+            cormat = ifelse(exists("cormat"),par_tmp[[session$token]][["SampleCorr"]]$cormat,NA),
+            annotationDF = ifelse(exists("annotationDF"),par_tmp[[session$token]][["SampleCorr"]]$annotationDF,NA),
+            customTitleSampleCorrelation = ifelse(exists("customTitleSampleCorrelation"),par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,NA),
+            anno_colors = ifelse(exists("anno_colors"),par_tmp[[session$token]][["SampleCorr"]]$anno_colors,NA)
           )
 
           temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
           dir.create(temp_directory)
 
-          write(getPlotCode(par_tmp[["SampleCorr"]]$sampleCorrelation_scenario), file.path(temp_directory, "Code.R"))
+          write(getPlotCode(par_tmp[[session$token]][["SampleCorr"]]$sampleCorrelation_scenario), file.path(temp_directory, "Code.R"))
 
           saveRDS(envList, file.path(temp_directory, "Data.RDS"))
           zip::zip(
@@ -184,18 +184,18 @@ sample_correlation_server <- function(id, data, params, updates){
 
       output$SavePlot_SampleCorrelation <- downloadHandler(
         filename = function() { 
-          paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_Heatmap,sep = "") 
+          paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_Heatmap,sep = "")
         },
         content = function(file){
-          save_pheatmap(par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final,filename = file,type=gsub("\\.","",input$file_ext_SampleCorrelation))
+          save_pheatmap(par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final,filename = file,type=gsub("\\.","",input$file_ext_SampleCorrelation))
           on.exit({
             tmp_filename <- paste0(
               getwd(),
               "/www/",
-              paste(paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_SampleCorrelation,sep = ""))
+              paste(paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_SampleCorrelation,sep = ""))
             )
             save_pheatmap(
-              par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final,
+              par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final,
               filename = tmp_filename,
               type = gsub("\\.","",input$file_ext_SampleCorrelation)
             )
@@ -216,11 +216,11 @@ sample_correlation_server <- function(id, data, params, updates){
         tmp_filename <- paste0(
           getwd(),
           "/www/",
-          paste(paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = ""))
+          paste(paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = ""))
         )
 
         save_pheatmap(
-          par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final,
+          par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final,
           filename = tmp_filename,
           type = "png"
         )

program/shinyApp/R/significance_analysis/server.R

@@ -180,8 +180,8 @@ significance_analysis_server <- function(id, data, params, updates){
       )
       # refresh the UI/data if needed
       observeEvent(input$refreshUI, {
-        data <- update_data(data, updates, sig_ana_reactive$current_updates)
-        params <- update_params(params, updates, sig_ana_reactive$current_updates)
+        data <- update_data(session$token)
+        params <- update_params(session$token)
         sig_ana_reactive$current_updates <- updates()
         sig_ana_reactive$coldata <- colData(data$data)
       })
@@ -200,7 +200,7 @@ significance_analysis_server <- function(id, data, params, updates){
         }
         print("Start the Significance Analysis")
         # update the data if needed
-        data <- update_data(data, updates, sig_ana_reactive$current_updates)
+        data <- update_data(session$token)
         sig_ana_reactive$current_updates <- updates()
         sig_ana_reactive$coldata <- colData(data$data)
         # delete old panels
@@ -228,10 +228,10 @@ significance_analysis_server <- function(id, data, params, updates){
           for (i in 1:length(contrasts)) {
             if(identical(
               list(test_method = "Wald", test_correction = PADJUST_METHOD[[input$test_correction]]),
-              par_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]]
+              par_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]]
             )){
               print("Results exists, skipping calculations.")
-              sig_results[[input$comparisons[i]]] <<- res_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]]
+              sig_results[[input$comparisons[i]]] <<- res_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]]
               next
             }
             sig_results[[input$comparisons[i]]] <<- DESeq2::results(
@@ -243,9 +243,9 @@ significance_analysis_server <- function(id, data, params, updates){
               ),
               pAdjustMethod = PADJUST_METHOD[[input$test_correction]]
             )
-            # fill in res_tmp, par_tmp
-            res_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]]
-            par_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- list(
+            # fill in res_tmp[[session$token]], par_tmp[[session$token]]
+            res_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]]
+            par_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- list(
               test_method = "Wald",
               test_correction = PADJUST_METHOD[[input$test_correction]]
             )