Working example with session id. Needs to be tested on server side.

program/shinyApp/R/enrichment_analysis/server.R

@@ -791,9 +791,9 @@ enrichment_analysis_Server <- function(id, data, params, updates){
           }
           ea_reactives$ea_info <- "**Enrichment Analysis Done!**"
           # res_temp Zuweisung
-          res_tmp[[session_key]]["Enrichment"] <<- ea_reactives$enrichment_results
+          res_tmp[[session$token]]["Enrichment"] <<- ea_reactives$enrichment_results
           # par_temp Zuweisung
-          par_tmp[[session_key]]["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

@@ -219,10 +219,9 @@ heatmap_server <- function(id, data, params, updates){
           input$anno_options,
           input$row_label_options
         )
-        browser()
         req(selectedData_processed())
         # update the data if needed
-        data <- update_data(data, session_key)
+        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
@@ -363,7 +362,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
               )
@@ -375,7 +373,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[[session_key]]$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!)")
@@ -456,15 +454,15 @@ heatmap_server <- function(id, data, params, updates){
         } else {
           print("Plotting saved result")
           if(input$LFC_toHeatmap){
-            myBreaks <- c(seq(min(res_tmp[[session_key]]$Heatmap$LFC), 0, length.out=ceiling(paletteLength/2) + 1),
-                            seq(max(res_tmp[[session_key]]$Heatmap$LFC)/paletteLength, max(res_tmp[[session_key]]$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[[session_key]]$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[[session_key]]$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,
@@ -475,12 +473,12 @@ heatmap_server <- function(id, data, params, updates){
                 color = myColor_fill
               )
           } else {
-            clusterRowspossible <- ifelse(nrow(as.matrix(res_tmp[[session_key]]$Heatmap))>1,input$cluster_rows,F)
-            if(any(is.na(res_tmp[[session_key]]$Heatmap))){
-              idx_of_nas <- which(apply(res_tmp[[session_key]]$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[[session_key]]$Heatmap <- res_tmp[[session_key]]$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]
@@ -497,9 +495,9 @@ heatmap_server <- function(id, data, params, updates){
             }
             scenario <- 11
             heatmap_plot <- pheatmap(
-              as.matrix(res_tmp[[session_key]]$Heatmap),
+              as.matrix(res_tmp[[session$token]]$Heatmap),
               main = customTitleHeatmap,
-              show_rownames = ifelse(nrow(res_tmp[[session_key]]$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,
@@ -534,26 +532,27 @@ heatmap_server <- function(id, data, params, updates){
         # Heatmap_Groups2Compare_ctrl_heatmap <- input$Groups2Compare_ctrl_heatmap
 
 
-        # res_tmp[[session_key]] gets data2HandOver or Data2Plot depending on scenario
+        # res_tmp[[session$token]] gets data2HandOver or Data2Plot depending on scenario
         if(scenario == 10){
-          res_tmp[[session_key]][["Heatmap"]] <<- Data2Plot
+          res_tmp[[session$token]][["Heatmap"]] <<- Data2Plot
         }else if(scenario == 11){
-          res_tmp[[session_key]][["Heatmap"]] <<- data2HandOver
+          res_tmp[[session$token]][["Heatmap"]] <<- data2HandOver
         }
-        # par_tmp[[session_key]] 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[[session_key]]$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[[session_key]]=res_tmp[[session_key]],
-              par_tmp[[session_key]]=par_tmp[[session_key]]
+            # 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()))
@@ -574,16 +573,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,
@@ -622,8 +621,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

@@ -150,7 +150,7 @@ pca_Server <- function(id, data, params, row_select, updates){
           dummy = "dummy",
           sample_selection_pca = input$sample_selection_pca,
           SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca
-        ), "PCA", session_key)
+        ), "PCA")
         if (check == "No Result yet"){
           output$PCA_Info <- renderText("PCA computed.")
           pca_reactives$calculate <- 1
@@ -188,7 +188,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, session_key)
+          data2plot <- update_data(session$token)
           # select the neccesary data
           if(input$data_selection_pca){
             data2plot <- select_data(
@@ -320,9 +320,9 @@ pca_Server <- function(id, data, params, row_select, updates){
           pca_reactives$df_loadings <- df_loadings
 
           # assign res_temp
-          res_tmp[[session_key]][["PCA"]] <<- list(pca)
+          res_tmp[[session$token]][["PCA"]] <<- list(pca)
           # assign par_temp as empty list
-          par_tmp[[session_key]][["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, session_key){
-  if (is.null(res_tmp[[session_key]][[module]])){  # chec whether result is existent
+check_calculations <- function(current_parameters, module){
+  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[[session_key]][[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, session_key)
+          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,10 +53,10 @@ sample_correlation_server <- function(id, data, params, updates){
               data_info = list(
                 rows = length(rownames(data$data)),
                 cols = length(colnames(data$data)),
-                preprocessing = par_tmp[[session_key]]$PreProcessing_Procedure
+                preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure
               )
             ),
-            "SampleCorrelation", session_key
+            "SampleCorrelation"
           )
           if (check == "No Result yet"){
             output$SampleCorr_Info <- renderText(
@@ -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[[session_key]]$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[[session_key]][["SampleCorrelation"]] <<- cormat
+          res_tmp[[session$token]][["SampleCorrelation"]] <<- cormat
           # assign par_temp["SampleCorrelation"]
-          par_tmp[[session_key]][["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[[session_key]]$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[[session_key]][["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[[session_key]][["SampleCorr"]]$cormat,NA),
-            annotationDF = ifelse(exists("annotationDF"),par_tmp[[session_key]][["SampleCorr"]]$annotationDF,NA),
-            customTitleSampleCorrelation = ifelse(exists("customTitleSampleCorrelation"),par_tmp[[session_key]][["SampleCorr"]]$customTitleSampleCorrelation,NA),
-            anno_colors = ifelse(exists("anno_colors"),par_tmp[[session_key]][["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[[session_key]][["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[[session_key]][["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[[session_key]][["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[[session_key]][["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[[session_key]][["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[[session_key]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = ""))
+          paste(paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = ""))
         )
 
         save_pheatmap(
-          par_tmp[[session_key]][["SampleCorr"]]$SampleCorrelationPlot_final,
+          par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final,
           filename = tmp_filename,
           type = "png"
         )