Download snippets (#162)

* replaced code snippet function

* add sample Correlation correct code snippet

* added PCA complete Code Snippets

* code download heatmap and singleGene

* add plots for sig analysis (UpSet and Venn)

* Volcano Code Snippets added

* delted old volcano

* typo fix

* overrepresentation download snippet

* actually select data based on selection specifications

---------

Co-authored-by: PaulJonasJost <[email protected]>

program/shinyApp/R/C.R

@@ -20,12 +20,32 @@ PADJUST_METHOD <<- list(
 
 CODE_DOWNLOAD_PREFACE <<- "# ShinyOmics R Code Download\n# Load necassary packages (if errors please install respective packages)
 library(ggplot2)
+library(ggvenn)
 library(ggpubr)
 library(rstudioapi)
+library(SummarizedExperiment)
+library(pheatmap)
+library(ComplexUpset)
+library(clusterProfiler)
+
+# make sure environment is empty
+
 # if not run in RStudio  you need to specify the directory fo the file yourself!
 
-direcoty_of_files=dirname(rstudioapi::getSourceEditorContext()$path)
-envList=readRDS(paste0(direcoty_of_files,'/','Data.rds'))  
+if(Sys.getenv('RSTUDIO')==1){
+  direcoty_of_files=dirname(rstudioapi::getSourceEditorContext()$path)
+  envList=readRDS(paste0(direcoty_of_files,'/','Data.rds'))
+  if('utils.R' %in% list.files(direcoty_of_files)){
+    source(file.path(direcoty_of_files,'utils.R'))
+  }
+}else{
+  # assuming to be in the correct directory (where Code lies)
+  envList=readRDS('Data.rds')
+  if('utils.R' %in% list.files()){
+    source('utils.R')
+  }
+}
+
 
 list2env(envList,envir = globalenv()) 
 # loads the varaibles directly into global env

program/shinyApp/R/SourceAll.R

@@ -1,9 +1,10 @@
+source("R/C.R",local = T)
 source("R/fun_filterRNA.R",local = T)
 source("R/fun_LFC.R",local = T)
 source("R/heatmap/fun_entitieSelection.R",local = T)
 source("R/fun_LogIt.R",local = T)
 source("R/fun_readInSampleTable.R",local = T)
-source("R/fun_ggplot.R",local = T)
+source("R/fun_getCodeSnippets.R",local = T)
 source("R/Guide.R",local = T)
 source("R/module_DownloadReport.R",local = T)
 source("R/enrichment_analysis/enrichment_analysis.R", local = T)
@@ -21,3 +22,4 @@ source("R/significance_analysis/server.R", local = T)
 source("R/significance_analysis/util.R", local = T)
 source("R/pre_processing/util.R", local = T)
 source("R/util.R", local = T)
+

program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R

@@ -9,6 +9,7 @@ over_representation_analysis <- function(
   # Overrepresentation analysis
   # no translation needed as already done before.
 
+
   # set Species
   species <- "Mus musculus"
   if(organsim == "Human genes (GRCh38.p14)"){

program/shinyApp/R/enrichment_analysis/server.R

@@ -29,30 +29,43 @@ enrichment_analysis_geneset_server <- function(
           hideElement(id = "EnrichmentFailure")
           output$EnrichmentPlot <- renderPlot({clusterProfiler::dotplot(result)})
           if(ea_type == "GeneSetEnrichment"){
-            ea_scenario <- 14
-          }else{
             ea_scenario <- 15
+          }else{
+            ea_scenario <- 14
           }
         }
         else{ # print that no significant result was found
           showElement(id = "EnrichmentFailure")
           output$EnrichmentFailure <- renderText("No significant result found. For further details check the table.")
           ea_scenario <- 0
         }
+
         # download R Code for further plotting
         output$getR_Code <- downloadHandler(
           filename = function(){
             paste0("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip")
           },
           content = function(file){
-            envList <- list(EnrichmentRes = result)
-            # assign unique name to result for saving later
-            result_name <- paste("EnrichmentRes", id, sep="_")
-            names(envList) <- result_name
-
+          #  tmp <- getUserReactiveValues(input)
+           # par_tmp$Enrichment[names(tmp)] <<- tmp
+              envList <- list(
+                res_tmp = res_tmp[[session$token]],
+                par_tmp = par_tmp[[session$token]]
+              )
             temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
             dir.create(temp_directory)
 
+            # functions needed
+            source("R/SourceAll.R")
+
+            save.function.from.env(wanted = c("check_annotation_enrichment_analysis",
+                                              "translate_genes_ea",
+                                              "translate_genes_oa",
+                                              "gene_set_enrichment",
+                                              "over_representation_analysis"),
+                                   file = file.path(temp_directory, "utils.R"))
+
+
             write(getPlotCode(ea_scenario), file.path(temp_directory, "Code.R"))
 
             saveRDS(envList, file.path(temp_directory, "Data.RDS"))
@@ -565,15 +578,15 @@ enrichment_analysis_Server <- function(id, data, params, updates){
       geneSetChoice <- reactive({
         if(isTruthy(input$GeneSet2Enrich)){
           if(input$GeneSet2Enrich == "DE_Genes"){
-            # atm this is not done
+            # TODO add option to send DE genes
             geneSetChoice_tmp <- DE_genelist()
           }
           if(input$GeneSet2Enrich == "ProvidedGeneSet"){
             if(!is.null(input$UploadedGeneSet)){
               Tmp <- read.csv(input$UploadedGeneSet$datapath, header = F)
-              # check take first column as acharacter vector
+              # check take first column as a character vector
               geneSetChoice_tmp <- Tmp$V1
-              ## Here somehow if value next to gene provieded needs to be considered further down
+              ## Here somehow if value next to gene provided needs to be considered further down
               # Check if they start with "ENS.."
               if(!length(which(grepl("ENS.*",geneSetChoice_tmp) == TRUE)) == length(geneSetChoice_tmp)){
                 print("wrong data!")
@@ -628,6 +641,8 @@ enrichment_analysis_Server <- function(id, data, params, updates){
         fun_LogIt("## ENRICHMENT")
         req(geneSetChoice())
         ea_reactives$tmp_genes <- geneSetChoice()
+        par_tmp[[session$token]]$Enrichment$tmp_genes <<- ea_reactives$tmp_genes
+        par_tmp[[session$token]]$Enrichment$enrichments2do <<- ea_reactives$enrichments2do
         # Check whether the necessary annotation is available
         anno_results <- check_annotation_enrichment_analysis(ea_reactives$data)
         ea_reactives$data <- anno_results$new_data
@@ -739,6 +754,8 @@ enrichment_analysis_Server <- function(id, data, params, updates){
               input$Groups2Compare_treat_GSEA,
               input$ValueToAttach
             )
+            tmp <- getUserReactiveValues(input)
+            par_tmp[[session$token]]$Enrichment[names(tmp)] <<- tmp
           }else{
             ea_reactives$enrichment_results <- over_representation_analysis(
               input,
@@ -748,20 +765,13 @@ enrichment_analysis_Server <- function(id, data, params, updates){
               ea_reactives$enrichments2do,
               input$test_correction
             )
+            tmp <- getUserReactiveValues(input)
+            par_tmp[[session$token]]$Enrichment[names(tmp)] <<- tmp
           }
           ea_reactives$ea_info <- "**Enrichment Analysis Done!**"
           # res_temp Zuweisung
           res_tmp[[session$token]]["Enrichment"] <<- ea_reactives$enrichment_results
-          # par_temp Zuweisung
-          par_tmp[[session$token]]["Enrichment"] <<- list(
-            "ValueToAttach" = input$ValueToAttach,
-            "GeneSet2Enrich" = input$GeneSet2Enrich,
-            "Groups2Compare_ref_GSEA" = input$Groups2Compare_ref_GSEA,
-            "Groups2Compare_treat_GSEA" = input$Groups2Compare_treat_GSEA,
-            "sample_annotation_types_cmp_GSEA" = input$sample_annotation_types_cmp_GSEA,
-            "ORA_or_GSE" = input$ORA_or_GSE,
-            "UniverseOfGene" = input$UniverseOfGene
-          )
+
         })
       })