From 125cfb74809d802c698b8a3e333d8c83259a1f83 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Tue, 16 Jan 2024 20:19:51 +0100 Subject: [PATCH 1/6] added session key to every res/par_tmp. Still needs to be adjusted accordingly in every function. --- .../enrichment_analysis/enrichment_analysis.R | 232 +++++------ .../overrepresentation_analysis.R | 240 ++++++------ .../shinyApp/R/enrichment_analysis/server.R | 4 +- program/shinyApp/R/fun_getCodeSnippets.R | 370 +++++++++--------- program/shinyApp/R/heatmap/server.R | 36 +- program/shinyApp/R/pca/server.R | 4 +- program/shinyApp/R/pca/util.R | 4 +- .../shinyApp/R/sample_correlation/server.R | 34 +- .../shinyApp/R/significance_analysis/server.R | 10 +- .../shinyApp/R/significance_analysis/util.R | 14 +- .../R/single_gene_visualisation/server.R | 30 +- program/shinyApp/R/util.R | 4 +- program/shinyApp/server.R | 232 ++++++----- program/shinyApp/www/Report.md | 7 - 14 files changed, 619 insertions(+), 602 deletions(-) delete mode 100644 program/shinyApp/www/Report.md diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R index 32a7a091..0becf147 100644 --- a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R @@ -49,7 +49,7 @@ gene_set_enrichment <- function( if(enrichments2do$KEGG){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$KEGG )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -64,15 +64,15 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$KEGG <<- EnrichmentRes_Kegg - par_tmp$EA[[comp_type]][[contrast]]$KEGG <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG <<- EnrichmentRes_Kegg + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_Kegg <- res_tmp$EA[[comp_type]][[contrast]]$KEGG + EnrichmentRes_Kegg <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG } } if(enrichments2do$GO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO )) ){ EnrichmentRes_GO <- clusterProfiler::gseGO( gene = geneSetChoice, @@ -85,16 +85,16 @@ gene_set_enrichment <- function( OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db"), pAdjustMethod = "none" # TODO: discuss ) - res_tmp$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO - par_tmp$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO <- res_tmp$EA[[comp_type]][[contrast]]$GO + EnrichmentRes_GO <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO } } # Hallmarks if(enrichments2do$Hallmarks){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$Hallmarks )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks )) ){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -108,16 +108,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$Hallmarks <<- EnrichmentRes_Hallmarks - par_tmp$EA[[comp_type]][[contrast]]$Hallmarks <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks <<- EnrichmentRes_Hallmarks + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_Hallmarks <- res_tmp$EA[[comp_type]][[contrast]]$Hallmarks + EnrichmentRes_Hallmarks <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks } } # C1 if(enrichments2do$C1){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C1 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 )) ){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -131,17 +131,17 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C1 <<- EnrichmentRes_C1 - par_tmp$EA[[comp_type]][[contrast]]$C1 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 <<- EnrichmentRes_C1 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C1 <- res_tmp$EA[[comp_type]][[contrast]]$C1 + EnrichmentRes_C1 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 } } # C2 if(enrichments2do$C2){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C2 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 )) ){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -155,16 +155,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C2 <<- EnrichmentRes_C2 - par_tmp$EA[[comp_type]][[contrast]]$C2 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 <<- EnrichmentRes_C2 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C2 <- res_tmp$EA[[comp_type]][[contrast]]$C2 + EnrichmentRes_C2 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 } } # C3 if(enrichments2do$C3){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C3 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 )) ){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -178,16 +178,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C3 <<- EnrichmentRes_C3 - par_tmp$EA[[comp_type]][[contrast]]$C3 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 <<- EnrichmentRes_C3 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C3 <- res_tmp$EA[[comp_type]][[contrast]]$C3 + EnrichmentRes_C3 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 } } # C4 if(enrichments2do$C4){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C4 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 )) ){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -201,16 +201,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C4 <<- EnrichmentRes_C4 - par_tmp$EA[[comp_type]][[contrast]]$C4 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 <<- EnrichmentRes_C4 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C4 <- res_tmp$EA[[comp_type]][[contrast]]$C4 + EnrichmentRes_C4 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 } } # C5 if(enrichments2do$C5){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C5 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 )) ){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -224,16 +224,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C5 <<- EnrichmentRes_C5 - par_tmp$EA[[comp_type]][[contrast]]$C5 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 <<- EnrichmentRes_C5 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C5 <- res_tmp$EA[[comp_type]][[contrast]]$C5 + EnrichmentRes_C5 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 } } # C6 if(enrichments2do$C6){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C6 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 )) ){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -247,16 +247,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C6 <<- EnrichmentRes_C6 - par_tmp$EA[[comp_type]][[contrast]]$C6 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 <<- EnrichmentRes_C6 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C6 <- res_tmp$EA[[comp_type]][[contrast]]$C6 + EnrichmentRes_C6 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 } } # C7 if(enrichments2do$C7){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C7 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -270,16 +270,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C7 <<- EnrichmentRes_C7 - par_tmp$EA[[comp_type]][[contrast]]$C7 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 <<- EnrichmentRes_C7 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C7 <- res_tmp$EA[[comp_type]][[contrast]]$C7 + EnrichmentRes_C7 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 } } # C8 if(enrichments2do$C8){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C8 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 )) ){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -293,16 +293,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$C8 <<- EnrichmentRes_C8 - par_tmp$EA[[comp_type]][[contrast]]$C8 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 <<- EnrichmentRes_C8 + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C8 <- res_tmp$EA[[comp_type]][[contrast]]$C8 + EnrichmentRes_C8 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 } } # C2 subset CGP if(enrichments2do$CGP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -317,16 +317,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$CGP <<- EnrichmentRes_CGP - par_tmp$EA[[comp_type]][[contrast]]$CGP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP <<- EnrichmentRes_CGP + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CGP <- res_tmp$EA[[comp_type]][[contrast]]$CGP + EnrichmentRes_CGP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP } } # C2 subset CP if(enrichments2do$CP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -341,16 +341,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$CP <<- EnrichmentRes_CP - par_tmp$EA[[comp_type]][[contrast]]$CP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP <<- EnrichmentRes_CP + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CP <- res_tmp$EA[[comp_type]][[contrast]]$CP + EnrichmentRes_CP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP } } # C2:CP subset BIOCARTA if(enrichments2do$BIOCARTA){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$BIOCARTA )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -365,16 +365,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$BIOCARTA <<- EnrichmentRes_BIOCARTA - par_tmp$EA[[comp_type]][[contrast]]$BIOCARTA <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- EnrichmentRes_BIOCARTA + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_BIOCARTA <- res_tmp$EA[[comp_type]][[contrast]]$BIOCARTA + EnrichmentRes_BIOCARTA <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA } } # C2:CP subset PID if(enrichments2do$PID){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$PID )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -389,16 +389,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$PID <<- EnrichmentRes_PID - par_tmp$EA[[comp_type]][[contrast]]$PID <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID <<- EnrichmentRes_PID + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_PID <- res_tmp$EA[[comp_type]][[contrast]]$PID + EnrichmentRes_PID <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID } } # C2:CP subset REACTOME if(enrichments2do$REACTOME){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$REACTOME )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -413,16 +413,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$REACTOME <<- EnrichmentRes_REACTOME - par_tmp$EA[[comp_type]][[contrast]]$REACTOME <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_REACTOME <- res_tmp$EA[[comp_type]][[contrast]]$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME } } # C2:CP subset WIKIPATHWAYS if(enrichments2do$WIKIPATHWAYS){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -437,16 +437,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS - par_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_WIKIPATHWAYS <- res_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS + EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS } } # C3 subset MIR:MIRDB if(enrichments2do$MIRDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$MIRDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -461,16 +461,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$MIRDB <<- EnrichmentRes_MIRDB - par_tmp$EA[[comp_type]][[contrast]]$MIRDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB <<- EnrichmentRes_MIRDB + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_MIRDB <- res_tmp$EA[[comp_type]][[contrast]]$MIRDB + EnrichmentRes_MIRDB <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB } } # C3 subset MIR:MIR_Legacy if(enrichments2do$MIR_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -485,16 +485,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy <<- EnrichmentRes_MIR_Legacy - par_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- EnrichmentRes_MIR_Legacy + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_MIR_Legacy <- res_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy + EnrichmentRes_MIR_Legacy <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy } } # C3 subset TFT:GTRD if(enrichments2do$GTRD){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GTRD )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -509,16 +509,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$GTRD <<- EnrichmentRes_GTRD - par_tmp$EA[[comp_type]][[contrast]]$GTRD <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD <<- EnrichmentRes_GTRD + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GTRD <- res_tmp$EA[[comp_type]][[contrast]]$GTRD + EnrichmentRes_GTRD <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD } } # C3 subset TFT:TFT_Legacy if(enrichments2do$TFT_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -533,16 +533,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy <<- EnrichmentRes_TFT_Legacy - par_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- EnrichmentRes_TFT_Legacy + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_TFT_Legacy <- res_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy + EnrichmentRes_TFT_Legacy <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy } } # C4 subset CGN if(enrichments2do$CGN){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGN )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -557,16 +557,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$CGN <<- EnrichmentRes_CGN - par_tmp$EA[[comp_type]][[contrast]]$CGN <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN <<- EnrichmentRes_CGN + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CGN <- res_tmp$EA[[comp_type]][[contrast]]$CGN + EnrichmentRes_CGN <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN } } # C4 subset CM if(enrichments2do$CM){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CM )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -581,16 +581,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$CM <<- EnrichmentRes_CM - par_tmp$EA[[comp_type]][[contrast]]$CM <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM <<- EnrichmentRes_CM + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CM <- res_tmp$EA[[comp_type]][[contrast]]$CM + EnrichmentRes_CM <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM } } # C5 subset GO BP if(enrichments2do$GO_BP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_BP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -605,16 +605,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$GO_BP <<- EnrichmentRes_GO_BP - par_tmp$EA[[comp_type]][[contrast]]$GO_BP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP <<- EnrichmentRes_GO_BP + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_BP <- res_tmp$EA[[comp_type]][[contrast]]$GO_BP + EnrichmentRes_GO_BP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP } } # C5 subset GO CC if(enrichments2do$GO_CC){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_CC )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -629,16 +629,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$GO_CC <<- EnrichmentRes_GO_CC - par_tmp$EA[[comp_type]][[contrast]]$GO_CC <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC <<- EnrichmentRes_GO_CC + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_CC <- res_tmp$EA[[comp_type]][[contrast]]$GO_CC + EnrichmentRes_GO_CC <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC } } # C5 subset GO MF if(enrichments2do$GO_MF){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_MF )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -653,16 +653,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$GO_MF <<- EnrichmentRes_GO_MF - par_tmp$EA[[comp_type]][[contrast]]$GO_MF <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF <<- EnrichmentRes_GO_MF + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_MF <- res_tmp$EA[[comp_type]][[contrast]]$GO_MF + EnrichmentRes_GO_MF <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF } } # C5 subset HPO if(enrichments2do$HPO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$HPO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -677,16 +677,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$HPO <<- EnrichmentRes_HPO - par_tmp$EA[[comp_type]][[contrast]]$HPO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO <<- EnrichmentRes_HPO + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_HPO <- res_tmp$EA[[comp_type]][[contrast]]$HPO + EnrichmentRes_HPO <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO } } # C7 subset IMMUNESIGDB if(enrichments2do$IMMUNESIGDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -701,16 +701,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB - par_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_IMMUNESIGDB <- res_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB + EnrichmentRes_IMMUNESIGDB <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB } } # C7 subset VAX if(enrichments2do$VAX){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$VAX )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -725,10 +725,10 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp$EA[[comp_type]][[contrast]]$VAX <<- EnrichmentRes_VAX - par_tmp$EA[[comp_type]][[contrast]]$VAX <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX <<- EnrichmentRes_VAX + par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_VAX <- res_tmp$EA[[comp_type]][[contrast]]$VAX + EnrichmentRes_VAX <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX } } diff --git a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R index c4720d8c..b44aa296 100644 --- a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R @@ -67,37 +67,37 @@ over_representation_analysis <- function( EnrichmentRes_C8 <- NULL # KEGG if(enrichments2do$KEGG){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$KEGG ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$KEGG ))){ EnrichmentRes_KEGG <- clusterProfiler::enrichKEGG( gene = geneSetChoice, organism = input$OrganismChoice, pvalueCutoff = 0.05, universe = universeSelected_tranlsated ) - res_tmp$OA$KEGG <<- EnrichmentRes_KEGG - par_tmp$OA$KEGG <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$KEGG <<- EnrichmentRes_KEGG + par_tmp[[session_key]]$OA$KEGG <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_KEGG <- res_tmp$OA$KEGG + EnrichmentRes_KEGG <- res_tmp[[session_key]]$OA$KEGG } } # GO if(enrichments2do$GO){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO ))){ EnrichmentRes_GO <- clusterProfiler::enrichGO( gene = geneSetChoice, ont = input$ontologyForGO, pvalueCutoff = 0.05, OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db") ) - res_tmp$OA$GO <<- EnrichmentRes_GO - par_tmp$OA$GO <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$GO <<- EnrichmentRes_GO + par_tmp[[session_key]]$OA$GO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO <- res_tmp$OA$GO + EnrichmentRes_GO <- res_tmp[[session_key]]$OA$GO } } # Reactome if(enrichments2do$REACTOME){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$REACTOME ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$REACTOME ))){ EnrichmentRes_REACTOME <- ReactomePA::enrichPathway( gene = geneSetChoice, pvalueCutoff = 0.05, @@ -105,15 +105,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, readable = T ) - res_tmp$OA$REACTOME <<- EnrichmentRes_REACTOME - par_tmp$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session_key]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp$OA$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session_key]]$OA$REACTOME } } # Hallmarks if(enrichments2do$Hallmarks){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$Hallmarks ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$Hallmarks ))){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "H", @@ -125,15 +125,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = Hallmarkset ) - res_tmp$OA$Hallmarks <<- EnrichmentRes_Hallmarks - par_tmp$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$Hallmarks <<- EnrichmentRes_Hallmarks + par_tmp[[session_key]]$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_Hallmarks <- res_tmp$OA$Hallmarks + EnrichmentRes_Hallmarks <- res_tmp[[session_key]]$OA$Hallmarks } } # C1 if(enrichments2do$C1){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C1 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C1 ))){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C1", @@ -145,15 +145,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C1set ) - res_tmp$OA$C1 <<- EnrichmentRes_C1 - par_tmp$OA$C1 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C1 <<- EnrichmentRes_C1 + par_tmp[[session_key]]$OA$C1 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C1 <- res_tmp$OA$C1 + EnrichmentRes_C1 <- res_tmp[[session_key]]$OA$C1 } } # C2 if(enrichments2do$C2){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C2 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C2 ))){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -165,15 +165,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C2set ) - res_tmp$OA$C2 <<- EnrichmentRes_C2 - par_tmp$OA$C2 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C2 <<- EnrichmentRes_C2 + par_tmp[[session_key]]$OA$C2 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C2 <- res_tmp$OA$C2 + EnrichmentRes_C2 <- res_tmp[[session_key]]$OA$C2 } } # C3 if(enrichments2do$C3){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C3 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C3 ))){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -185,15 +185,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C3set ) - res_tmp$OA$C3 <<- EnrichmentRes_C3 - par_tmp$OA$C3 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C3 <<- EnrichmentRes_C3 + par_tmp[[session_key]]$OA$C3 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C3 <- res_tmp$OA$C3 + EnrichmentRes_C3 <- res_tmp[[session_key]]$OA$C3 } } # C4 if(enrichments2do$C4){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C4 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C4 ))){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -205,15 +205,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C4set ) - res_tmp$OA$C4 <<- EnrichmentRes_C4 - par_tmp$OA$C4 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C4 <<- EnrichmentRes_C4 + par_tmp[[session_key]]$OA$C4 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C4 <- res_tmp$OA$C4 + EnrichmentRes_C4 <- res_tmp[[session_key]]$OA$C4 } } # C5 if(enrichments2do$C5){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C5 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C5 ))){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -225,15 +225,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C5set ) - res_tmp$OA$C5 <<- EnrichmentRes_C5 - par_tmp$OA$C5 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C5 <<- EnrichmentRes_C5 + par_tmp[[session_key]]$OA$C5 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C5 <- res_tmp$OA$C5 + EnrichmentRes_C5 <- res_tmp[[session_key]]$OA$C5 } } # C6 if(enrichments2do$C6){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C6 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C6 ))){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C6", @@ -245,15 +245,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C6set ) - res_tmp$OA$C6 <<- EnrichmentRes_C6 - par_tmp$OA$C6 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C6 <<- EnrichmentRes_C6 + par_tmp[[session_key]]$OA$C6 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C6 <- res_tmp$OA$C6 + EnrichmentRes_C6 <- res_tmp[[session_key]]$OA$C6 } } # C7 ImmuneSigDB subset if(enrichments2do$C7){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C7 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C7 ))){ C7set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -266,15 +266,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C7set ) - res_tmp$OA$C7 <<- EnrichmentRes_C7 - par_tmp$OA$C7 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C7 <<- EnrichmentRes_C7 + par_tmp[[session_key]]$OA$C7 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C7 <- res_tmp$OA$C7 + EnrichmentRes_C7 <- res_tmp[[session_key]]$OA$C7 } } # C8 if(enrichments2do$C8){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C8 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C8 ))){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C8", @@ -286,15 +286,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C8set ) - res_tmp$OA$C8 <<- EnrichmentRes_C8 - par_tmp$OA$C8 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$C8 <<- EnrichmentRes_C8 + par_tmp[[session_key]]$OA$C8 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C8 <- res_tmp$OA$C8 + EnrichmentRes_C8 <- res_tmp[[session_key]]$OA$C8 } } # C2 subset CGP if(enrichments2do$CGP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CGP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CGP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -307,15 +307,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$CGP <<- EnrichmentRes_CGP - par_tmp$OA$CGP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$CGP <<- EnrichmentRes_CGP + par_tmp[[session_key]]$OA$CGP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGP <- res_tmp$OA$CGP + EnrichmentRes_CGP <- res_tmp[[session_key]]$OA$CGP } } # C2 subset CP if(enrichments2do$CP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -328,15 +328,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$CP <<- EnrichmentRes_CP - par_tmp$OA$CP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$CP <<- EnrichmentRes_CP + par_tmp[[session_key]]$OA$CP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CP <- res_tmp$OA$CP + EnrichmentRes_CP <- res_tmp[[session_key]]$OA$CP } } # C2:CP subset BIOCARTA if(enrichments2do$BIOCARTA){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$BIOCARTA ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$BIOCARTA ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -349,15 +349,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA - par_tmp$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA + par_tmp[[session_key]]$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_BIOCARTA <- res_tmp$OA$BIOCARTA + EnrichmentRes_BIOCARTA <- res_tmp[[session_key]]$OA$BIOCARTA } } # C2:CP subset PID if(enrichments2do$PID){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$PID ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$PID ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -370,15 +370,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$PID <<- EnrichmentRes_PID - par_tmp$OA$PID <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$PID <<- EnrichmentRes_PID + par_tmp[[session_key]]$OA$PID <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_PID <- res_tmp$OA$PID + EnrichmentRes_PID <- res_tmp[[session_key]]$OA$PID } } # C2:CP subset REACTOME if(enrichments2do$REACTOME){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$REACTOME ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$REACTOME ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -391,15 +391,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$REACTOME <<- EnrichmentRes_REACTOME - par_tmp$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session_key]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp$OA$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session_key]]$OA$REACTOME } } # C2:CP subset WIKIPATHWAYS if(enrichments2do$WIKIPATHWAYS){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$WIKIPATHWAYS ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$WIKIPATHWAYS ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -412,15 +412,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS - par_tmp$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS + par_tmp[[session_key]]$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_WIKIPATHWAYS <- res_tmp$OA$WIKIPATHWAYS + EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session_key]]$OA$WIKIPATHWAYS } } # C3 subset MIR:MIRDB if(enrichments2do$MIRDB){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$MIRDB ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$MIRDB ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -433,15 +433,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$MIRDB <<- EnrichmentRes_MIRDB - par_tmp$OA$MIRDB <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$MIRDB <<- EnrichmentRes_MIRDB + par_tmp[[session_key]]$OA$MIRDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIRDB <- res_tmp$OA$MIRDB + EnrichmentRes_MIRDB <- res_tmp[[session_key]]$OA$MIRDB } } # C3 subset MIR:MIR_Legacy if(enrichments2do$MIR_Legacy){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$MIR_Legacy ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$MIR_Legacy ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -454,15 +454,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy - par_tmp$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy + par_tmp[[session_key]]$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIR_Legacy <- res_tmp$OA$MIR_Legacy + EnrichmentRes_MIR_Legacy <- res_tmp[[session_key]]$OA$MIR_Legacy } } # C3 subset TFT:GTRD if(enrichments2do$GTRD){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GTRD ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GTRD ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -475,15 +475,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$GTRD <<- EnrichmentRes_GTRD - par_tmp$OA$GTRD <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$GTRD <<- EnrichmentRes_GTRD + par_tmp[[session_key]]$OA$GTRD <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GTRD <- res_tmp$OA$GTRD + EnrichmentRes_GTRD <- res_tmp[[session_key]]$OA$GTRD } } # C3 subset TFT:TFT_Legacy if(enrichments2do$TFT_Legacy){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$TFT_Legacy ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$TFT_Legacy ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -496,15 +496,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy - par_tmp$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy + par_tmp[[session_key]]$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_TFT_Legacy <- res_tmp$OA$TFT_Legacy + EnrichmentRes_TFT_Legacy <- res_tmp[[session_key]]$OA$TFT_Legacy } } # C4 subset CGN if(enrichments2do$CGN){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CGN ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CGN ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -517,15 +517,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$CGN <<- EnrichmentRes_CGN - par_tmp$OA$CGN <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$CGN <<- EnrichmentRes_CGN + par_tmp[[session_key]]$OA$CGN <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGN <- res_tmp$OA$CGN + EnrichmentRes_CGN <- res_tmp[[session_key]]$OA$CGN } } # C4 subset CM if(enrichments2do$CM){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CM ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CM ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -538,15 +538,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$CM <<- EnrichmentRes_CM - par_tmp$OA$CM <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$CM <<- EnrichmentRes_CM + par_tmp[[session_key]]$OA$CM <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CM <- res_tmp$OA$CM + EnrichmentRes_CM <- res_tmp[[session_key]]$OA$CM } } # C5 subset GO BP if(enrichments2do$GO_BP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_BP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_BP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -559,15 +559,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$GO_BP <<- EnrichmentRes_GO_BP - par_tmp$OA$GO_BP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$GO_BP <<- EnrichmentRes_GO_BP + par_tmp[[session_key]]$OA$GO_BP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_BP <- res_tmp$OA$GO_BP + EnrichmentRes_GO_BP <- res_tmp[[session_key]]$OA$GO_BP } } # C5 subset GO CC if(enrichments2do$GO_CC){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_CC ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_CC ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -580,15 +580,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$GO_CC <<- EnrichmentRes_GO_CC - par_tmp$OA$GO_CC <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$GO_CC <<- EnrichmentRes_GO_CC + par_tmp[[session_key]]$OA$GO_CC <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_CC <- res_tmp$OA$GO_CC + EnrichmentRes_GO_CC <- res_tmp[[session_key]]$OA$GO_CC } } # C5 subset GO MF if(enrichments2do$GO_MF){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_MF ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_MF ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -601,15 +601,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$GO_MF <<- EnrichmentRes_GO_MF - par_tmp$OA$GO_MF <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$GO_MF <<- EnrichmentRes_GO_MF + par_tmp[[session_key]]$OA$GO_MF <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_MF <- res_tmp$OA$GO_MF + EnrichmentRes_GO_MF <- res_tmp[[session_key]]$OA$GO_MF } } # C5 subset HPO if(enrichments2do$HPO){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$HPO ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$HPO ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -622,15 +622,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$HPO <<- EnrichmentRes_HPO - par_tmp$OA$HPO <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$HPO <<- EnrichmentRes_HPO + par_tmp[[session_key]]$OA$HPO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_HPO <- res_tmp$OA$HPO + EnrichmentRes_HPO <- res_tmp[[session_key]]$OA$HPO } } # C7 subset IMMUNESIGDB if(enrichments2do$IMMUNESIGDB){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$IMMUNESIGDB ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$IMMUNESIGDB ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -643,15 +643,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB - par_tmp$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB + par_tmp[[session_key]]$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_IMMUNESIGDB <- res_tmp$OA$IMMUNESIGDB + EnrichmentRes_IMMUNESIGDB <- res_tmp[[session_key]]$OA$IMMUNESIGDB } } # C7 subset VAX if(enrichments2do$VAX){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$VAX ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$VAX ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -664,10 +664,10 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp$OA$VAX <<- EnrichmentRes_VAX - par_tmp$OA$VAX <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session_key]]$OA$VAX <<- EnrichmentRes_VAX + par_tmp[[session_key]]$OA$VAX <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_VAX <- res_tmp$OA$VAX + EnrichmentRes_VAX <- res_tmp[[session_key]]$OA$VAX } } diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R index 751b5441..bc91fa91 100644 --- a/program/shinyApp/R/enrichment_analysis/server.R +++ b/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["Enrichment"] <<- ea_reactives$enrichment_results + res_tmp[[session_key]]["Enrichment"] <<- ea_reactives$enrichment_results # par_temp Zuweisung - par_tmp["Enrichment"] <<- list( + par_tmp[[session_key]]["Enrichment"] <<- list( "ValueToAttach" = input$ValueToAttach, "GeneSet2Enrich" = input$GeneSet2Enrich, "Groups2Compare_ref_GSEA" = input$Groups2Compare_ref_GSEA, diff --git a/program/shinyApp/R/fun_getCodeSnippets.R b/program/shinyApp/R/fun_getCodeSnippets.R index 4c451d6b..54e1f5eb 100644 --- a/program/shinyApp/R/fun_getCodeSnippets.R +++ b/program/shinyApp/R/fun_getCodeSnippets.R @@ -1,33 +1,33 @@ getPlotCode <- function( numberOfScenario, - preProcessing_Snippet = par_tmp$PreProcessing_Procedure, - row_selection = par_tmp$row_selection, - col_selection = par_tmp$col_selection) { - #TODO change all data download to par_tmp and res_tmp + preProcessing_Snippet = par_tmp[[session_key]]$PreProcessing_Procedure, + row_selection = par_tmp[[session_key]]$row_selection, + col_selection = par_tmp[[session_key]]$col_selection) { + #TODO change all data download to par_tmp[[session_key]] and res_tmp[[session_key]] # Selection ---- - if(any(par_tmp$row_selection == "all")){ - stringSelection <- 'selected <- rownames(rowData(res_tmp$data_original)) + if(any(par_tmp[[session_key]]$row_selection == "all")){ + stringSelection <- 'selected <- rownames(rowData(res_tmp[[session_key]]$data_original)) ' }else{ - if(!(length(par_tmp$row_selection) == 1 & any(par_tmp$row_selection == "High Values+IQR"))){ + if(!(length(par_tmp[[session_key]]$row_selection) == 1 & any(par_tmp[[session_key]]$row_selection == "High Values+IQR"))){ stringSelection <- 'selected <- c() selected <- unique( - c(selected,rownames(rowData(res_tmp$data_original))[ - which(rowData(res_tmp$data_original) - [,par_tmp$providedRowAnnotationTypes]%in%par_tmp$row_selection)] + c(selected,rownames(rowData(res_tmp[[session_key]]$data_original))[ + which(rowData(res_tmp[[session_key]]$data_original) + [,par_tmp[[session_key]]$providedRowAnnotationTypes]%in%par_tmp[[session_key]]$row_selection)] ) ) ' } - if(any(par_tmp$row_selection == "High Values+IQR") ){ + if(any(par_tmp[[session_key]]$row_selection == "High Values+IQR") ){ stringSelection <- 'toKeep <- filter_rna( - rna = assay(res_tmp$data_original), - prop = par_tmp$propensityChoiceUser + rna = assay(res_tmp[[session_key]]$data_original), + prop = par_tmp[[session_key]]$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] ' - if(length(par_tmp$row_selection) == 1){ + if(length(par_tmp[[session_key]]$row_selection) == 1){ stringSelection <- paste0(stringSelection, 'selected <- rownames(filteredIQR_Expr)') }else{ @@ -40,95 +40,95 @@ selected <- unique( } } - if(par_tmp$col_selection == "all"){ + if(par_tmp[[session_key]]$col_selection == "all"){ stringSelection <- paste0(stringSelection,"\n", - 'samples_selected <- colnames(assay(res_tmp$data_original)) + 'samples_selected <- colnames(assay(res_tmp[[session_key]]$data_original)) ') }else{ stringSelection <- paste0(stringSelection, 'samples_selected <- c( samples_selected, - rownames(colData(res_tmp$data_original))[which( - colData(res_tmp$data_original)[,par_tmp$providedSampleAnnotationTypes] %in% par_tmp$sample_selection + rownames(colData(res_tmp[[session_key]]$data_original))[which( + colData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$providedSampleAnnotationTypes] %in% par_tmp[[session_key]]$sample_selection )] ) ') } # Preprocessing ---- - if(par_tmp$PreProcessing_Procedure != "none"){ - if(par_tmp$PreProcessing_Procedure == "filter_only"){ - if(par_tmp$omic_type == "Transcriptomics"){ + if(par_tmp[[session_key]]$PreProcessing_Procedure != "none"){ + if(par_tmp[[session_key]]$PreProcessing_Procedure == "filter_only"){ + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ stringPreProcessing <- 'processedData <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' } - if(par_tmp$omic_type == "Metabolomics"){ + if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ stringPreProcessing <- 'processedData <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' } prequel_stringPreProcessing <- c("") }else{ - if(par_tmp$omic_type == "Transcriptomics"){ - prequel_stringPreProcessing <- 'res_tmp$data <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ + prequel_stringPreProcessing <- 'res_tmp[[session_key]]$data <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' } - if(par_tmp$omic_type == "Metabolomics"){ - prequel_stringPreProcessing <- 'res_tmp$data <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' + if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ + prequel_stringPreProcessing <- 'res_tmp[[session_key]]$data <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' } } - if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"){ + if(par_tmp[[session_key]]$PreProcessing_Procedure == "simpleCenterScaling"){ stringPreProcessing <- 'processedData <- as.data.frame(t( scale( - x = as.data.frame(t(as.data.frame(assay(res_tmp$data)))), + x = as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data)))), scale = T, center = T ) ) ) - assay(res_tmp$data) <- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) ' } - if(par_tmp$PreProcessing_Procedure == "vst_DESeq"){ + if(par_tmp[[session_key]]$PreProcessing_Procedure == "vst_DESeq"){ stringPreProcessing <- 'dds <- DESeq2::DESeqDataSetFromMatrix( - countData = assay(res_tmp$data), - colData = colData(res_tmp$data), - design = as.formula(par_tmp$DESeq_formula) + countData = assay(res_tmp[[session_key]]$data), + colData = colData(res_tmp[[session_key]]$data), + design = as.formula(par_tmp[[session_key]]$DESeq_formula) ) de_seq_result <- DESeq2::DESeq(dds) - res_tmp$DESeq_obj <- de_seq_result + res_tmp[[session_key]]$DESeq_obj <- de_seq_result dds_vst <- vst( object = de_seq_result, blind = TRUE ) - assay(res_tmp$data) <- as.data.frame(assay(dds_vst)) + assay(res_tmp[[session_key]]$data) <- as.data.frame(assay(dds_vst)) ' } if(input$PreProcessing_Procedure == "Scaling_0_1"){ stringPreProcessing <- 'processedData <- as.data.frame(t( - apply(assay(res_tmp$data),1,function(x){ + apply(assay(res_tmp[[session_key]]$data),1,function(x){ (x - min(x))/(max(x) - min(x)) }) )) - assay(res_tmp$data) <- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) ' } if(input$PreProcessing_Procedure == "ln"){ stringPreProcessing <- 'processedData <- as.data.frame(log( - as.data.frame(assay(res_tmp$data)) + as.data.frame(assay(res_tmp[[session_key]]$data)) )) - assay(res_tmp$data) <- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) ' } if(input$PreProcessing_Procedure == "log10"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp$data)) + stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) if(any(processedData==0)){ processedData <- as.data.frame(log10( processedData + 1) ) - assay(res_tmp$data) <- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) }' } if(input$PreProcessing_Procedure == "pareto_scaling"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp$data)) + stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) centered <- as.data.frame(t( apply(processedData, 1, function(x){x - mean(x)}) )) @@ -136,7 +136,7 @@ selected <- unique( apply(centered, 1, function(x){x/sqrt(sd(x))}) )) - assay(res_tmp$data) <- as.data.frame(pareto.matrix) + assay(res_tmp[[session_key]]$data) <- as.data.frame(pareto.matrix) ' } stringPreProcessing <- paste0(prequel_stringPreProcessing,"\n",stringPreProcessing) @@ -149,59 +149,59 @@ selected <- unique( ## PCA ---- if(numberOfScenario >= 1 & numberOfScenario < 9){ # Calculate all necessary intermediate data sets - prequel_stringtosave <- 'pcaData <- data.frame(res_tmp$PCA$x,colData(res_tmp$data)) + prequel_stringtosave <- 'pcaData <- data.frame(res_tmp[[session_key]]$PCA$x,colData(res_tmp[[session_key]]$data)) # Annotation (important for plotly) if(!any(colnames(pcaData) == "global_ID")){ pcaData$global_ID <- rownames(pcaData) } - if(!is.null(par_tmp$PCA$PCA_anno_tooltip)){ - adj2colname <- gsub(" ",".",par_tmp$PCA$PCA_anno_tooltip) + if(!is.null(par_tmp[[session_key]]$PCA$PCA_anno_tooltip)){ + adj2colname <- gsub(" ",".",par_tmp[[session_key]]$PCA$PCA_anno_tooltip) pcaData$chosenAnno <- pcaData[,adj2colname] }else{ pcaData$chosenAnno <- pcaData$global_ID } # Scree Plot calculations var_explained_df <- data.frame( - PC = paste0("PC",1:ncol(res_tmp$PCA$x)), - var_explained = (res_tmp$PCA$sdev)^2/sum((res_tmp$PCA$sdev)^2) + PC = paste0("PC",1:ncol(res_tmp[[session_key]]$PCA$x)), + var_explained = (res_tmp[[session_key]]$PCA$sdev)^2/sum((res_tmp[[session_key]]$PCA$sdev)^2) ) var_explained_df$Var <- paste0(round(var_explained_df$var_explained,4)*100,"%") -var_explained_df$PC <- factor(var_explained_df$PC,levels = paste0("PC",1:ncol(res_tmp$PCA$x))) +var_explained_df$PC <- factor(var_explained_df$PC,levels = paste0("PC",1:ncol(res_tmp[[session_key]]$PCA$x))) percentVar <- round(100 * var_explained_df$var_explained, digits = 1) names(percentVar)<- var_explained_df$PC # Loadings calculations LoadingsDF <- data.frame( - entitie = rownames(res_tmp$PCA$rotation), - Loading = res_tmp$PCA$rotation[,par_tmp$PCA$x_axis_selection] + entitie = rownames(res_tmp[[session_key]]$PCA$rotation), + Loading = res_tmp[[session_key]]$PCA$rotation[,par_tmp[[session_key]]$PCA$x_axis_selection] ) LoadingsDF <- LoadingsDF[order(LoadingsDF$Loading,decreasing = T),] LoadingsDF <- rbind( -LoadingsDF[nrow(LoadingsDF):(nrow(LoadingsDF) - par_tmp$PCA$bottomSlider),], - LoadingsDF[par_tmp$PCA$topSlider:1,] +LoadingsDF[nrow(LoadingsDF):(nrow(LoadingsDF) - par_tmp[[session_key]]$PCA$bottomSlider),], + LoadingsDF[par_tmp[[session_key]]$PCA$topSlider:1,] ) LoadingsDF$entitie <- factor(LoadingsDF$entitie,levels = rownames(LoadingsDF)) -if(!is.null(par_tmp$PCA$EntitieAnno_Loadings)){ +if(!is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings)){ LoadingsDF$entitie=factor( - make.unique(as.character(rowData(res_tmp$data)[rownames(LoadingsDF),par_tmp$PCA$EntitieAnno_Loadings])), - levels = make.unique(as.character(rowData(res_tmp$data)[rownames(LoadingsDF),par_tmp$PCA$EntitieAnno_Loadings])) + make.unique(as.character(rowData(res_tmp[[session_key]]$data)[rownames(LoadingsDF),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings])), + levels = make.unique(as.character(rowData(res_tmp[[session_key]]$data)[rownames(LoadingsDF),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings])) ) } df_loadings <- data.frame( - entity = row.names(res_tmp$PCA$rotation), - res_tmp$PCA$rotation[, 1:par_tmp$PCA$nPCAs_to_look_at] + entity = row.names(res_tmp[[session_key]]$PCA$rotation), + res_tmp[[session_key]]$PCA$rotation[, 1:par_tmp[[session_key]]$PCA$nPCAs_to_look_at] ) -df_loadings_filtered <- as.matrix(df_loadings[,-1]) >= abs(par_tmp$PCA$filterValue) +df_loadings_filtered <- as.matrix(df_loadings[,-1]) >= abs(par_tmp[[session_key]]$PCA$filterValue) entitiesToInclude <- apply(df_loadings_filtered, 1, any) df_loadings <- df_loadings[entitiesToInclude,] %>% tidyr::gather(key = "PC", value = "loading", -entity) -if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ +if(!is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix)){ df_loadings$chosenAnno <- factor( - make.unique(as.character(rowData(res_tmp$data)[unique(df_loadings$entity),par_tmp$PCA$EntitieAnno_Loadings_matrix])), - levels = make.unique(as.character(rowData(res_tmp$data)[unique(df_loadings$entity),par_tmp$PCA$EntitieAnno_Loadings_matrix])) + make.unique(as.character(rowData(res_tmp[[session_key]]$data)[unique(df_loadings$entity),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix])), + levels = make.unique(as.character(rowData(res_tmp[[session_key]]$data)[unique(df_loadings$entity),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix])) ) }else{ df_loadings$chosenAnno <- df_loadings$entity @@ -209,69 +209,69 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ ' if (numberOfScenario == 1) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_manual(name = par_tmp$PCA$coloring_options,values=par_tmp$PCA$colorTheme)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_manual(name = par_tmp[[session_key]]$PCA$coloring_options,values=par_tmp[[session_key]]$PCA$colorTheme)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)' + ggtitle(par_tmp[[session_key]]$PCA$customTitle)' } if (numberOfScenario == 2) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_discrete(name = par_tmp$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_discrete(name = par_tmp[[session_key]]$PCA$coloring_options)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)' + ggtitle(par_tmp[[session_key]]$PCA$customTitle)' } if (numberOfScenario == 3) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_manual(values=par_tmp$PCA$colorTheme, - name = par_tmp$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_manual(values=par_tmp[[session_key]]$PCA$colorTheme, + name = par_tmp[[session_key]]$PCA$coloring_options)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)' + ggtitle(par_tmp[[session_key]]$PCA$customTitle)' } if (numberOfScenario == 4) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_manual(name = par_tmp$PCA$coloring_options,values=par_tmp$PCA$colorTheme)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_manual(name = par_tmp[[session_key]]$PCA$coloring_options,values=par_tmp[[session_key]]$PCA$colorTheme)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], + ggtitle(par_tmp[[session_key]]$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], aes(x=0, y=0, xend=v1, yend=v2), arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), #linetype="solid", @@ -281,20 +281,20 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ } if (numberOfScenario == 5) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_discrete(name = par_tmp$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_discrete(name = par_tmp[[session_key]]$PCA$coloring_options)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)+ + ggtitle(par_tmp[[session_key]]$PCA$customTitle)+ geom_segment(data=df_out_r[which(df_out_r$feature!=""),], aes(x=0, y=0, xend=v1, yend=v2), arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), @@ -303,21 +303,21 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ color="#ab0521")' } if (numberOfScenario == 6) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$PCA$coloring_options], + stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], + y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], + color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], label=global_ID, global_ID=global_ID, chosenAnno=chosenAnno)) + geom_point(size =3)+ - scale_color_manual(values=par_tmp$PCA$colorTheme, - name = par_tmp$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp$PCA$x_axis_selection]),": ",percentVar[par_tmp$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp$PCA$y_axis_selection]),": ", percentVar[par_tmp$PCA$y_axis_selection], "% variance")) + + scale_color_manual(values=par_tmp[[session_key]]$PCA$colorTheme, + name = par_tmp[[session_key]]$PCA$coloring_options)+ + xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + + ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + coord_fixed()+ theme_classic()+ theme(aspect.ratio = 1)+ - ggtitle(par_tmp$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], + ggtitle(par_tmp[[session_key]]$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], aes(x=0, y=0, xend=v1, yend=v2), arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), #linetype="solid", @@ -341,8 +341,8 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ breaks = LoadingsDF$entitie, labels = stringr::str_wrap(gsub("\\\\.[0-9].*$","",LoadingsDF$entitie),20)) + scale_fill_gradient2(low = "#277d6a",mid = "white",high = "orange") + - ylab(ifelse(is.null(par_tmp$PCA$EntitieAnno_Loadings),"",par_tmp$PCA$EntitieAnno_Loadings)) + - xlab(paste0("Loadings: ",par_tmp$PCA$x_axis_selection)) + + ylab(ifelse(is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings),"",par_tmp[[session_key]]$PCA$EntitieAnno_Loadings)) + + xlab(paste0("Loadings: ",par_tmp[[session_key]]$PCA$x_axis_selection)) + theme_bw(base_size = 15)' } ### Loadings matrix @@ -365,19 +365,19 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){ ## Volcano ---- if (numberOfScenario == 9) { - stringtosave='VolcanoPlot <- ggplot(res_tmp$Volcano, + stringtosave='VolcanoPlot <- ggplot(res_tmp[[session_key]]$Volcano, aes(label=probename,tooltip=annotation_add)) + geom_point(aes(x = LFC,y = -log10(p_adj),colour = threshold,alpha = threshold_fc)) + geom_hline( - yintercept = -log10(par_tmp$Volcano$psig_threhsold), + yintercept = -log10(par_tmp[[session_key]]$Volcano$psig_threhsold), color="lightgrey" ) + geom_vline( - xintercept = c(-par_tmp$Volcano$lfc_threshold,par_tmp$Volcano$lfc_threshold), + xintercept = c(-par_tmp[[session_key]]$Volcano$lfc_threshold,par_tmp[[session_key]]$Volcano$lfc_threshold), color="lightgrey" ) + - scale_color_manual(values=par_tmp$Volcano$colorScheme, name="")+ - scale_alpha_manual(values=par_tmp$Volcano$alphaScheme, name="")+ + scale_color_manual(values=par_tmp[[session_key]]$Volcano$colorScheme, name="")+ + scale_alpha_manual(values=par_tmp[[session_key]]$Volcano$alphaScheme, name="")+ xlab("Log FoldChange")+ ylab("-log10(p-value)")+ theme_bw()' @@ -391,13 +391,13 @@ paletteLength <- 25 myColor_fill <- colorRampPalette(c("blue", "white", "firebrick"))(paletteLength) # select and caluculate Heatmap input depending on users input - -# check par_tmp$Heatmap for selected options or change accrodingly to what you desire +# check par_tmp[[session_key]]$Heatmap for selected options or change accrodingly to what you desire mycolors <- list() -if(length(par_tmp$Heatmap$anno_options) == 1){ - if(length(unique(colData(res_tmp$data)[,par_tmp$Heatmap$anno_options])) <= 8){ - names(colorTheme) <- unique(colData(res_tmp$data)[,par_tmp$Heatmap$anno_options]) +if(length(par_tmp[[session_key]]$Heatmap$anno_options) == 1){ + if(length(unique(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options])) <= 8){ + names(colorTheme) <- unique(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options]) colorTheme <- colorTheme[!is.na(names(colorTheme))] - mycolors[[par_tmp$Heatmap$anno_options]] <- colorTheme + mycolors[[par_tmp[[session_key]]$Heatmap$anno_options]] <- colorTheme } } @@ -405,16 +405,16 @@ if(length(par_tmp$Heatmap$anno_options) == 1){ # Do PreSelection of input to Heatmap to show # selection based on row Annotation: -if(!(any(par_tmp$Heatmap$row_selection_options == "all"))){ - if(any(par_tmp$Heatmap$row_selection_options == "rowAnno_based")){ - additionalInput_row_anno <- ifelse(any(par_tmp$Heatmap$row_selection_options == "rowAnno_based"),"yip",NA) +if(!(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "all"))){ + if(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based")){ + additionalInput_row_anno <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),"yip",NA) if(!is.na(additionalInput_row_anno)){ - additionalInput_row_anno <- par_tmp$Heatmap$anno_options_heatmap + additionalInput_row_anno <- par_tmp[[session_key]]$Heatmap$anno_options_heatmap } - additionalInput_row_anno_factor <- par_tmp$Heatmap$row_anno_options_heatmap + additionalInput_row_anno_factor <- par_tmp[[session_key]]$Heatmap$row_anno_options_heatmap }else{ - additionalInput_row_anno <- ifelse(any(par_tmp$Heatmap$row_selection_options == "rowAnno_based"),par_tmp$Heatmap$anno_options_heatmap,NA) - additionalInput_row_anno_factor <- ifelse(any(par_tmp$Heatmap$row_selection_options == "rowAnno_based"),c(par_tmp$Heatmap$row_anno_options_heatmap),NA) + additionalInput_row_anno <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),par_tmp[[session_key]]$Heatmap$anno_options_heatmap,NA) + additionalInput_row_anno_factor <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),c(par_tmp[[session_key]]$Heatmap$row_anno_options_heatmap),NA) } }else{ additionalInput_row_anno <- "all" @@ -422,17 +422,17 @@ if(!(any(par_tmp$Heatmap$row_selection_options == "all"))){ } #Selection and/or ordering based on LFC -additionalInput_sample_annotation_types <- ifelse(is.null(par_tmp$Heatmap$sample_annotation_types_cmp_heatmap),NA,par_tmp$Heatmap$sample_annotation_types_cmp_heatmap) -additionalInput_ctrl_idx <- ifelse(is.null(par_tmp$Heatmap$Groups2Compare_ref_heatmap),NA,par_tmp$Heatmap$Groups2Compare_ref_heatmap) -additionalInput_cmp_idx <- ifelse(is.null(par_tmp$Heatmap$Groups2Compare_treat_heatmap),NA,par_tmp$Heatmap$Groups2Compare_treat_heatmap) -psig_threhsold <- ifelse(is.null(par_tmp$Heatmap$psig_threhsold_heatmap),NA,par_tmp$Heatmap$psig_threhsold_heatmap) +additionalInput_sample_annotation_types <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap),NA,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap) +additionalInput_ctrl_idx <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap),NA,par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap) +additionalInput_cmp_idx <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap),NA,par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap) +psig_threhsold <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$psig_threhsold_heatmap),NA,par_tmp[[session_key]]$Heatmap$psig_threhsold_heatmap) # select TopK (if there is an ordering) -TopK2Show <- ifelse(any(par_tmp$Heatmap$row_selection_options=="TopK"),par_tmp$Heatmap$TopK,NA) +TopK2Show <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options=="TopK"),par_tmp[[session_key]]$Heatmap$TopK,NA) -if(any(par_tmp$Heatmap$row_selection_options=="all")){ +if(any(par_tmp[[session_key]]$Heatmap$row_selection_options=="all")){ print("No entitie selection") - data2HandOver <- as.data.frame(assay(res_tmp$data)) + data2HandOver <- as.data.frame(assay(res_tmp[[session_key]]$data)) }else{ # Note entitieSelection is a custom function #TODO its source code file should be provided along! @@ -573,8 +573,8 @@ getLFC <- function( data2HandOver <- entitieSelection( - res_tmp$data, - type = par_tmp$Heatmap$row_selection_options, + res_tmp[[session_key]]$data, + type = par_tmp[[session_key]]$Heatmap$row_selection_options, additionalInput_row_anno = additionalInput_row_anno, additionalInput_row_anno_factor = additionalInput_row_anno_factor, additionalInput_sample_annotation_types = additionalInput_sample_annotation_types, @@ -595,20 +595,20 @@ if(is.null(data2HandOver)){ if(numberOfScenario == 10){ stringtosave <- ' -annotation_col <- rowData(res_tmp$data)[,par_tmp$Heatmap$row_anno_options,drop=F] +annotation_col <- rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] ctrl_samples_idx <- which( - colData(res_tmp$data)[,par_tmp$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp$Heatmap$Groups2Compare_ref_heatmap + colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap ) comparison_samples_idx <- which( - colData(res_tmp$data)[,par_tmp$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp$Heatmap$Groups2Compare_treat_heatmap + colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap ) if(length(comparison_samples_idx) <=1 | length(ctrl_samples_idx) <=1){ print("Choose variable with at least two samples per condition!") doThis_flag <- F } -if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"| any(data2HandOver)< 0){ +if(par_tmp[[session_key]]$PreProcessing_Procedure == "simpleCenterScaling"| any(data2HandOver)< 0){ print("Remember do not use normal center + scaling (negative Values!)") }else if(doThis_flag){ Data2Plot <- getLFC( @@ -617,10 +617,10 @@ if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"| any(data2HandOver)< comparison_samples_idx = comparison_samples_idx ) -if(par_tmp$Heatmap$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))) - annotation_col <- rowData(res_tmp$data)[rownames(Data2Plot),par_tmp$Heatmap$row_anno_options,drop=F] +if(par_tmp[[session_key]]$Heatmap$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))) + annotation_col <- rowData(res_tmp[[session_key]]$data)[rownames(Data2Plot),par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] } @@ -628,9 +628,9 @@ heatmap_plot <- pheatmap((t(Data2Plot[,"LFC",drop=F])), main="Heatmap - LFC", show_rownames=ifelse(nrow(Data2Plot)<=25,TRUE,FALSE), show_colnames=TRUE, - cluster_cols = par_tmp$Heatmap$cluster_cols, - cluster_rows = FALSE, # par_tmp$Heatmap$cluster_rows, - scale=ifelse(par_tmp$Heatmap$rowWiseScaled,"row","none"), + cluster_cols = par_tmp[[session_key]]$Heatmap$cluster_cols, + cluster_rows = FALSE, # par_tmp[[session_key]]$Heatmap$cluster_rows, + scale=ifelse(par_tmp[[session_key]]$Heatmap$rowWiseScaled,"row","none"), # cutree_cols = 4, #fontsize = font.size, annotation_col = annotation_col, @@ -641,22 +641,22 @@ heatmap_plot <- pheatmap((t(Data2Plot[,"LFC",drop=F])), } if(numberOfScenario == 11){ stringtosave <- ' -annotation_col <- colData(res_tmp$data)[,par_tmp$Heatmap$anno_options,drop=F] -annotation_row <- rowData(res_tmp$data)[,par_tmp$Heatmap$row_anno_options,drop=F] +annotation_col <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options,drop=F] +annotation_row <- rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] # convert both to data.frame annotation_col <- as.data.frame(annotation_col) annotation_row <- as.data.frame(annotation_row) -clusterRowspossible <- ifelse(nrow(as.matrix(assay(res_tmp$data)))>1,par_tmp$Heatmap$cluster_rows,F) +clusterRowspossible <- ifelse(nrow(as.matrix(assay(res_tmp[[session_key]]$data)))>1,par_tmp[[session_key]]$Heatmap$cluster_rows,F) -heatmap_plot <- pheatmap(as.matrix(res_tmp$Heatmap), +heatmap_plot <- pheatmap(as.matrix(res_tmp[[session_key]]$Heatmap), main="Heatmap", - show_rownames=ifelse(nrow((assay(res_tmp$data)))<=par_tmp$Heatmap$row_label_no,TRUE,FALSE), - labels_row = rowData(res_tmp$data)[rownames(assay(res_tmp$data)),par_tmp$Heatmap$row_label_options], + show_rownames=ifelse(nrow((assay(res_tmp[[session_key]]$data)))<=par_tmp[[session_key]]$Heatmap$row_label_no,TRUE,FALSE), + labels_row = rowData(res_tmp[[session_key]]$data)[rownames(assay(res_tmp[[session_key]]$data)),par_tmp[[session_key]]$Heatmap$row_label_options], show_colnames=TRUE, - cluster_cols = par_tmp$Heatmap$cluster_cols, + cluster_cols = par_tmp[[session_key]]$Heatmap$cluster_cols, cluster_rows = clusterRowspossible, - scale=ifelse(par_tmp$Heatmap$rowWiseScaled,"row","none"), + scale=ifelse(par_tmp[[session_key]]$Heatmap$rowWiseScaled,"row","none"), # cutree_cols = 4, #fontsize = font.size, annotation_col = annotation_col, @@ -671,11 +671,11 @@ stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave) ## Single Gene Visualisation ---- if(numberOfScenario %in% c(12,13)){ - if(par_tmp$SingleEntVis$type_of_data_gene == "preprocessed"){ + if(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene == "preprocessed"){ prequel_stringtosave <- '#get IDX to data -idx_selected <- which(par_tmp$SingleEntVis$Select_Gene == rowData(res_tmp$data)[,par_tmp$SingleEntVis$Select_GeneAnno]) -GeneData <- as.data.frame(t(as.data.frame(assay(res_tmp$data))[idx_selected,,drop=F])) -GeneData$anno <- colData(res_tmp$data)[,par_tmp$SingleEntVis$accross_condition] +idx_selected <- which(par_tmp[[session_key]]$SingleEntVis$Select_Gene == rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$Select_GeneAnno]) +GeneData <- as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data))[idx_selected,,drop=F])) +GeneData$anno <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$accross_condition] if(length(idx_selected)>1){ # summarise the data GeneData_medians <- rowMedians(as.matrix(GeneData[,-ncol(GeneData)])) @@ -685,13 +685,13 @@ if(length(idx_selected)>1){ } GeneData$anno <- as.factor(GeneData$anno) ' - }else if(par_tmp$SingleEntVis$type_of_data_gene == "raw" ){ + }else if(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene == "raw" ){ prequel_stringtosave <- '#get IDX to data -idx_selected <- which(par_tmp$SingleEntVis$Select_Gene == rowData(res_tmp$data_original)[,par_tmp$SingleEntVis$Select_GeneAnno]) -GeneData <- as.data.frame(t(assay(res_tmp$data_original)[idx_selected,,drop=F])) -GeneData$anno <- colData(res_tmp$data_original)[,par_tmp$SingleEntVis$accross_condition] +idx_selected <- which(par_tmp[[session_key]]$SingleEntVis$Select_Gene == rowData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$SingleEntVis$Select_GeneAnno]) +GeneData <- as.data.frame(t(assay(res_tmp[[session_key]]$data_original)[idx_selected,,drop=F])) +GeneData$anno <- colData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$SingleEntVis$accross_condition] # select to selection of processed data -annoToSelect=unique(c(colData(res_tmp$data)[,par_tmp$SingleEntVis$accross_condition])) +annoToSelect=unique(c(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$accross_condition])) GeneData = subset(GeneData, anno %in% annoToSelect) if(length(idx_selected)>1){ # summarise the data @@ -705,35 +705,35 @@ GeneData$anno <- as.factor(GeneData$anno) } if (numberOfScenario == 12) { - stringtosave = '# GeneData now contains the same as res_tmp$SingleEntVis -P_boxplots <- ggplot(res_tmp$SingleEntVis, - aes(y=res_tmp$SingleEntVis[,colnames(res_tmp$SingleEntVis)[-ncol(res_tmp$SingleEntVis)]], + stringtosave = '# GeneData now contains the same as res_tmp[[session_key]]$SingleEntVis +P_boxplots <- ggplot(res_tmp[[session_key]]$SingleEntVis, + aes(y=res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]], x=anno, fill=anno))+ geom_boxplot()+ # unable if less then 4 samples in all groups to get the same plot as in the App geom_point(shape = 21,size=5)+ scale_fill_brewer(palette="RdBu")+ - xlab(par_tmp$SingleEntVis$Select_Gene)+ - ylab(par_tmp$SingleEntVis$type_of_data_gene)+ + xlab(par_tmp[[session_key]]$SingleEntVis$Select_Gene)+ + ylab(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene)+ theme_bw()+ - geom_hline(yintercept = mean(res_tmp$SingleEntVis[,colnames(res_tmp$SingleEntVis)[-ncol(res_tmp$SingleEntVis)]]), linetype = 2)+ # Add horizontal line at base mean + geom_hline(yintercept = mean(res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]]), linetype = 2)+ # Add horizontal line at base mean #stat_compare_means(method = "anova")+ # Add global annova p-value - stat_compare_means(comparisons = par_tmp$SingleEntVis$chooseComparisons_list, - method = par_tmp$SingleEntVis$testMethod, + stat_compare_means(comparisons = par_tmp[[session_key]]$SingleEntVis$chooseComparisons_list, + method = par_tmp[[session_key]]$SingleEntVis$testMethod, label = "p.signif", hide.ns = TRUE)' } if (numberOfScenario == 13) { - stringtosave = '# GeneData now contains the same as res_tmp$SingleEntVis -P_boxplots <- ggplot(res_tmp$SingleEntVis, - aes(y=res_tmp$SingleEntVis[,colnames(res_tmp$SingleEntVis)[-ncol(res_tmp$SingleEntVis)]], + stringtosave = '# GeneData now contains the same as res_tmp[[session_key]]$SingleEntVis +P_boxplots <- ggplot(res_tmp[[session_key]]$SingleEntVis, + aes(y=res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]], x=anno, fill=anno))+ geom_boxplot()+# unable if less then 4 samples in all groups to get the same plot as in the App geom_point(shape = 21,size=5)+ scale_fill_brewer(palette="RdBu")+ - xlab(par_tmp$SingleEntVis$Select_Gene)+ - ylab(par_tmp$SingleEntVis$type_of_data_gene)+ + xlab(par_tmp[[session_key]]$SingleEntVis$Select_Gene)+ + ylab(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene)+ theme_bw()' } stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave) @@ -756,27 +756,27 @@ P_boxplots <- ggplot(res_tmp$SingleEntVis, ## Sample Correlation plot ---- if(numberOfScenario == 18){ - stringtosave = 'annotationDF <- colData(res_tmp$data)[,par_tmp$SampleCorr$SampleAnnotationChoice,drop = F] + stringtosave = 'annotationDF <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SampleCorr$SampleAnnotationChoice,drop = F] cormat <- cor( - x = as.matrix(assay(res_tmp$data)), - method = par_tmp$SampleCorr$corrMethod + x = as.matrix(assay(res_tmp[[session_key]]$data)), + method = par_tmp[[session_key]]$SampleCorr$corrMethod ) SampleCorrelationPlot <- pheatmap( -mat = cormat, #res_tmp$SampleCorr -annotation_row = par_tmp$SampleCorr$annotationDF, -main = par_tmp$SampleCorr$customTitleSampleCorrelation, -annotation_colors = par_tmp$SampleCorr$anno_colors +mat = cormat, #res_tmp[[session_key]]$SampleCorr +annotation_row = par_tmp[[session_key]]$SampleCorr$annotationDF, +main = par_tmp[[session_key]]$SampleCorr$customTitleSampleCorrelation, +annotation_colors = par_tmp[[session_key]]$SampleCorr$anno_colors )' } ## Significance Analysis ----- ### Venn Diagram ---- if(numberOfScenario == 20){ - stringtosave <- 'VennDiagramm <- ggVennDiagram::ggVennDiagram(res_tmp$SignificanceAnalysis)' + stringtosave <- 'VennDiagramm <- ggVennDiagram::ggVennDiagram(res_tmp[[session_key]]$SignificanceAnalysis)' } ### Upset plot ---- if(numberOfScenario == 21){ - stringtosave <- 'UpSetR::upset(fromList(res_tmp$SignificanceAnalysis))' + stringtosave <- 'UpSetR::upset(fromList(res_tmp[[session_key]]$SignificanceAnalysis))' } ### Volcano ---- diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R index cd325e00..df7b3561 100644 --- a/program/shinyApp/R/heatmap/server.R +++ b/program/shinyApp/R/heatmap/server.R @@ -374,7 +374,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_key]]$PreProcessing_Procedure == "simpleCenterScaling"| any(assay(data$data))< 0){ print("Remember do not use normal center + scaling (negative Values!)") @@ -455,15 +455,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_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))) 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_key]]$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_key]]$Heatmap)<=25,TRUE,FALSE), show_colnames = TRUE, cluster_cols = input$cluster_cols, cluster_rows = FALSE, @@ -474,12 +474,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_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? print(idx_of_nas) if(length(idx_of_nas)>0){ - res_tmp$Heatmap <- res_tmp$Heatmap[-idx_of_nas,] + res_tmp[[session_key]]$Heatmap <- res_tmp[[session_key]]$Heatmap[-idx_of_nas,] } annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F] @@ -496,9 +496,9 @@ heatmap_server <- function(id, data, params, updates){ } scenario <- 11 heatmap_plot <- pheatmap( - as.matrix(res_tmp$Heatmap), + as.matrix(res_tmp[[session_key]]$Heatmap), main = customTitleHeatmap, - show_rownames = ifelse(nrow(res_tmp$Heatmap)<=input$row_label_no,TRUE,FALSE), + show_rownames = ifelse(nrow(res_tmp[[session_key]]$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, @@ -533,16 +533,16 @@ 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_key]] gets data2HandOver or Data2Plot depending on scenario if(scenario == 10){ - res_tmp[["Heatmap"]] <<- Data2Plot + res_tmp[[session_key]][["Heatmap"]] <<- Data2Plot }else if(scenario == 11){ - res_tmp[["Heatmap"]] <<- data2HandOver + res_tmp[[session_key]][["Heatmap"]] <<- data2HandOver } - # par_tmp gets the parameters used for the heatmap + # par_tmp[[session_key]] 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_key]]$Heatmap[names(tmp)] <<- tmp output$getR_Code_Heatmap <- downloadHandler( @@ -552,8 +552,8 @@ heatmap_server <- function(id, data, params, updates){ content = function(file){ envList=list( - res_tmp=res_tmp, - par_tmp=par_tmp + res_tmp[[session_key]]=res_tmp[[session_key]], + par_tmp[[session_key]]=par_tmp[[session_key]] ) temp_directory <- file.path(tempdir(), as.integer(Sys.time())) diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R index bf38b017..b92df35d 100644 --- a/program/shinyApp/R/pca/server.R +++ b/program/shinyApp/R/pca/server.R @@ -320,9 +320,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_key]][["PCA"]] <<- list(pca) # assign par_temp as empty list - par_tmp[["PCA"]] <<- list( + par_tmp[[session_key]][["PCA"]] <<- list( # add a dummy parameter to avoid error dummy = "dummy", sample_selection_pca = input$sample_selection_pca, diff --git a/program/shinyApp/R/pca/util.R b/program/shinyApp/R/pca/util.R index 26bd3c60..702bca74 100644 --- a/program/shinyApp/R/pca/util.R +++ b/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_key]][[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_key]][[module]], current_parameters)){ return("Result exists") } # The remaining case is an existing result with other parameters, diff --git a/program/shinyApp/R/sample_correlation/server.R b/program/shinyApp/R/sample_correlation/server.R index fe44d197..8d233f1e 100644 --- a/program/shinyApp/R/sample_correlation/server.R +++ b/program/shinyApp/R/sample_correlation/server.R @@ -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_key]]$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_key]]$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_key]][["SampleCorrelation"]] <<- cormat # assign par_temp["SampleCorrelation"] - par_tmp[["SampleCorrelation"]] <<- list( + par_tmp[[session_key]][["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_key]]$PreProcessing_Procedure ) ) @@ -141,7 +141,7 @@ sample_correlation_server <- function(id, data, params, updates){ customTitleSampleCorrelation <- "SampleCorrelation" } - par_tmp[["SampleCorr"]] <<- list( + par_tmp[[session_key]][["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_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) ) 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_key]][["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_key]][["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_key]][["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_key]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_SampleCorrelation,sep = "")) ) save_pheatmap( - par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final, + par_tmp[[session_key]][["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_key]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = "")) ) save_pheatmap( - par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final, + par_tmp[[session_key]][["SampleCorr"]]$SampleCorrelationPlot_final, filename = tmp_filename, type = "png" ) diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index 8a72aad8..c762a9ad 100644 --- a/program/shinyApp/R/significance_analysis/server.R +++ b/program/shinyApp/R/significance_analysis/server.R @@ -229,10 +229,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_key]]$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_key]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] next } sig_results[[input$comparisons[i]]] <<- DESeq2::results( @@ -244,9 +244,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_key]], par_tmp[[session_key]] + res_tmp[[session_key]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]] + par_tmp[[session_key]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- list( test_method = "Wald", test_correction = PADJUST_METHOD[[input$test_correction]] ) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 26fa9fb2..913b4427 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -811,10 +811,10 @@ significance_analysis <- function( # skip if already there if(identical( list(test_method = method, test_correction = correction), - par_tmp$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] + par_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] )){ print("Results exists, skipping calculations.") - sig_results[[names(contrasts)[comp_name]]] <- res_tmp$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] + sig_results[[names(contrasts)[comp_name]]] <- res_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] comp_name <- comp_name + 1 next } @@ -850,9 +850,9 @@ significance_analysis <- function( sig_results[[names(contrasts)[comp_name]]] <- res - # fill res_tmp, par_tmp - res_tmp$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- res - par_tmp$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- list( + # fill res_tmp[[session_key]], par_tmp[[session_key]] + res_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- res + par_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- list( test_method = method, test_correction = correction ) @@ -925,9 +925,9 @@ getLFC <- function(means){ ) return (df$LFC) } - if(par_tmp$PreProcessing_Procedure == "log10"){ + if(par_tmp[[session_key]]$PreProcessing_Procedure == "log10"){ lfc_per_gene_log(means, log_base = 10) - }else if(par_tmp$PreProcessing_Procedure == "ln"){ + }else if(par_tmp[[session_key]]$PreProcessing_Procedure == "ln"){ lfc_per_gene_log(means, log_base = exp(1)) }else{ lfc_per_gene(means) diff --git a/program/shinyApp/R/single_gene_visualisation/server.R b/program/shinyApp/R/single_gene_visualisation/server.R index 74ddf40c..f0ba73e8 100644 --- a/program/shinyApp/R/single_gene_visualisation/server.R +++ b/program/shinyApp/R/single_gene_visualisation/server.R @@ -254,11 +254,11 @@ single_gene_visualisation_server <- function(id, data, params, updates){ } # Where to save the plot (needed currently to be global, to be able to be saved) - res_tmp[["SingleEntVis"]] <<- P_boxplots + res_tmp[[session_key]][["SingleEntVis"]] <<- P_boxplots #SingleEnt_P_boxplots <- P_boxplots - # DO not know if necassary to track in par_tmp (if not global var needed) - par_tmp[["SingleEntVis"]] <<- list( + # DO not know if necassary to track in par_tmp[[session_key]] (if not global var needed) + par_tmp[[session_key]][["SingleEntVis"]] <<- list( SingleEnt_customTitle_boxplot = SingleEnt_customTitle_boxplot, SingleEnt_Select_Gene = input$Select_Gene, SingleEnt_type_of_data_gene = input$type_of_data_gene, @@ -306,7 +306,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ output$SavePlot_singleGene <- downloadHandler( filename = function() { paste( - par_tmp$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), input$file_ext_singleGene,sep="" @@ -316,7 +316,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ content = function(file){ ggsave( file = file, - plot = res_tmp$SingleEntVis, + plot = res_tmp[[session_key]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) @@ -325,14 +325,14 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), input$file_ext_singleGene,sep="") ) ggsave( filename = tmp_filename, - plot = res_tmp$SingleEntVis, + plot = res_tmp[[session_key]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) fun_LogIt("## Single Entitie") @@ -360,7 +360,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), ".png", @@ -368,27 +368,27 @@ single_gene_visualisation_server <- function(id, data, params, updates){ ) ggsave( filename = tmp_filename, - plot = res_tmp$SingleEntVis, + plot = res_tmp[[session_key]]$SingleEntVis, device = "png" ) fun_LogIt(message = "## Single Entitie") fun_LogIt(message = paste0( "**Single Entitie** - The following single entitie was plotted: ", - par_tmp$SingleEntVis$SingleEnt_Select_Gene)) + par_tmp[[session_key]]$SingleEntVis$SingleEnt_Select_Gene)) fun_LogIt(message = paste0( "**Single Entitie** - Values shown are: ", - par_tmp$SingleEntVis$SingleEnt_type_of_data_gene, " data input")) + par_tmp[[session_key]]$SingleEntVis$SingleEnt_type_of_data_gene, " data input")) fun_LogIt(message = paste0( "**Single Entitie** - Values are grouped for all levels within: ", - par_tmp$SingleEntVis$SingleEnt_accross_condition, + par_tmp[[session_key]]$SingleEntVis$SingleEnt_accross_condition, " (", - paste0(levels(par_tmp$SingleEntVis$SingleEnt_GeneData_anno),collapse = ";") + paste0(levels(par_tmp[[session_key]]$SingleEntVis$SingleEnt_GeneData_anno),collapse = ";") ,")")) fun_LogIt(message = paste0( "**Single Entitie** - Test for differences: ", - par_tmp$SingleEntVis$SingleEnt_testMethod)) + par_tmp[[session_key]]$SingleEntVis$SingleEnt_testMethod)) - if(length(levels(par_tmp$SingleEntVis$SingleEnt_GeneData_anno))>2){ + if(length(levels(par_tmp[[session_key]]$SingleEntVis$SingleEnt_GeneData_anno))>2){ fun_LogIt( message = paste0("**Single Entitie** - ANOVA performed, reference group is the overall mean") ) diff --git a/program/shinyApp/R/util.R b/program/shinyApp/R/util.R index b3a77c2d..f69daaeb 100644 --- a/program/shinyApp/R/util.R +++ b/program/shinyApp/R/util.R @@ -4,7 +4,7 @@ update_data <- function(data, updates, current_updates){ # for stability reasons, data is ALWAYS pulled here print("Updating data...") - data <- res_tmp + data <- res_tmp[[session_key]] return(data) } @@ -32,7 +32,7 @@ update_params <- function(params, updates, current_updates){ # could force to always update if (updates() > current_updates & current_updates > 0){ print("Updating parameters...") - params <- par_tmp + params <- par_tmp[[session_key]] } return(params) } diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index e8ec7043..5e5652d8 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -3,6 +3,9 @@ server <- function(input,output,session){ source("R/util.R") global_Vars <<- reactiveValues() # OUTDATED? + + # session sepcific key + session_key <- session$token # getCurrentVersion(updateDESCRIPTION=T) # Where to Place this ? So it does not always get 'updated'? # Can we add this somehow as necassary to every new release? @@ -67,9 +70,14 @@ server <- function(input,output,session){ hideTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations") hideTab(inputId = "tabsetPanel1", target = "Enrichment Analysis") -# Init res Object ---- - res_tmp <<- list() - par_tmp <<- list() +# Init res_tmp and par_tmp objects if they do not yet exist ---- + if(!exists("res_tmp")){ + res_tmp <<- list() + par_tmp <<- list() + } + # create an empty list in res/par_tmp[[session_key]] + res_tmp[[session_key]] <<- list() + par_tmp[[session_key]] <<- list() # Init update Object ---- # updating is a reative value that counts up whenever data is updated # this is used to trigger the update of the servers @@ -186,7 +194,7 @@ server <- function(input,output,session){ content = function(file){ # TODO Q: What to save here? only original enough? saveRDS( - object = res_tmp$data_original, + object = res_tmp[[session_key]]$data_original, file = file ) } @@ -344,11 +352,11 @@ server <- function(input,output,session){ ## Do Upload ---- observeEvent(input$refresh1,{ - par_tmp['omic_type'] <<- input$omicType + par_tmp[[session_key]]['omic_type'] <<- input$omicType fun_LogIt(message = "## DataInput {.tabset .tabset-fade}") fun_LogIt(message = "### Info") fun_LogIt( - message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp['omic_type']) + message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp[[session_key]]['omic_type']) ) if(!(isTruthy(input$data_preDone) | FLAG_TEST_DATA_SELECTED() | @@ -360,8 +368,8 @@ server <- function(input,output,session){ output$debug <- renderText({"The Test Data Set was used"}) }else{ show_toast( - title = paste0(par_tmp['omic_type'],"Data Upload"), - text = paste0(par_tmp['omic_type'],"-data upload was successful"), + title = paste0(par_tmp[[session_key]]['omic_type'],"Data Upload"), + text = paste0(par_tmp[[session_key]]['omic_type'],"-data upload was successful"), position = "top", timer = 1500, timerProgressBar = T @@ -490,25 +498,33 @@ server <- function(input,output,session){ #TODO make the copy and tab show process dependent if we get here a results object or 'simple' rds } # TODO SumExp only needed hence more restructuring needed - res_tmp[['data_original']] <<- data_input[[paste0(input$omicType,"_SumExp")]] + res_tmp[[session_key]][['data_original']] <<- data_input[[paste0(input$omicType,"_SumExp")]] # Make a copy, to leave original data untouched - res_tmp[['data']] <<- res_tmp$data_original + res_tmp[[session_key]][['data']] <<- res_tmp[[session_key]]$data_original # Count up updating updating$count <- updating$count + 1 - print(paste0("(before) No. anno options sample_table: ",ncol(res_tmp$data_original))) - colData(res_tmp$data) <- - DataFrame(as.data.frame(colData(res_tmp$data)) %>% + print(paste0( + "(before) No. anno options sample_table: ",ncol(res_tmp[[session_key]]$data_original) + )) + colData(res_tmp[[session_key]]$data) <- + DataFrame(as.data.frame(colData(res_tmp[[session_key]]$data)) %>% purrr::keep(~length(unique(.x)) != 1)) - print(paste0("(after) No. anno options sample_table: ",ncol(res_tmp$data))) + print(paste0( + "(after) No. anno options sample_table: ",ncol(res_tmp[[session_key]]$data) + )) - print(paste0("(before) No. anno options annotation_rows: ",ncol(res_tmp$data_original))) + print(paste0( + "(before) No. anno options annotation_rows: ",ncol(res_tmp[[session_key]]$data_original) + )) - rowData(res_tmp$data) <- - DataFrame(as.data.frame(rowData(res_tmp$data)) %>% + rowData(res_tmp[[session_key]]$data) <- + DataFrame(as.data.frame(rowData(res_tmp[[session_key]]$data)) %>% purrr::keep(~length(unique(.x)) != 1)) - print(paste0("(after) No. anno options annotation_rows: ",ncol(res_tmp$data))) + print(paste0( + "(after) No. anno options annotation_rows: ",ncol(res_tmp[[session_key]]$data) + )) fun_LogIt( message = @@ -516,13 +532,13 @@ server <- function(input,output,session){ ) fun_LogIt( message = paste0("**DataInput** - The raw data dimensions are:", - paste0(dim(res_tmp$data_original),collapse = ", ")) + paste0(dim(res_tmp[[session_key]]$data_original),collapse = ", ")) ) fun_LogIt(message = "### Publication Snippet") fun_LogIt(message = snippet_dataInput( - data_type = par_tmp$omic_type, - data_dimension = paste0(dim(res_tmp$data_original),collapse = ", ") + data_type = par_tmp[[session_key]]$omic_type, + data_dimension = paste0(dim(res_tmp[[session_key]]$data_original),collapse = ", ") )) fun_LogIt(message = "
") return("DataUploadSuccesful") @@ -534,14 +550,14 @@ server <- function(input,output,session){ ## Ui Section ---- observe({ req(data_input_shiny()) - isTruthy(res_tmp$data) + isTruthy(res_tmp[[session_key]]$data) # Row output$providedRowAnnotationTypes_ui=renderUI({ req(data_input_shiny()) shinyWidgets::virtualSelectInput( inputId = "providedRowAnnotationTypes", label = "Which annotation type do you want to select on?", - choices = c(colnames(rowData(res_tmp$data_original))), + choices = c(colnames(rowData(res_tmp[[session_key]]$data_original))), multiple = F, search = T, showSelectedOptionsFirst = T @@ -551,7 +567,9 @@ server <- function(input,output,session){ output$row_selection_ui=renderUI({ req(data_input_shiny()) req(input$providedRowAnnotationTypes) - if(is.numeric(rowData(res_tmp$data_original)[,input$providedRowAnnotationTypes])){ + if(is.numeric( + rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes]) + ){ selectInput( inputId = "row_selection", label = "Which entities to use? (Your input category is numeric, selection is currently only supported for categorical data!)", @@ -563,7 +581,7 @@ server <- function(input,output,session){ shinyWidgets::virtualSelectInput( inputId = "row_selection", label = "Which entities to use? (Will be the union if multiple selected)", - choices = c("High Values+IQR","all",unique(unlist(strsplit(rowData(res_tmp$data_original)[,input$providedRowAnnotationTypes],"\\|")))), + choices = c("High Values+IQR","all",unique(unlist(strsplit(rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes],"\\|")))), selected = "all", multiple = T, search = T, @@ -594,8 +612,8 @@ server <- function(input,output,session){ selectInput( inputId = "providedSampleAnnotationTypes", label = "Which annotation type do you want to select on?", - choices = c(colnames(colData(res_tmp$data_original))), - selected = c(colnames(colData(res_tmp$data_original)))[1], + choices = c(colnames(colData(res_tmp[[session_key]]$data_original))), + selected = c(colnames(colData(res_tmp[[session_key]]$data_original)))[1], multiple = F ) }) @@ -604,9 +622,10 @@ server <- function(input,output,session){ selectInput( inputId = "sample_selection", label = "Which entities to use? (Will be the union if multiple selected)", - choices = c("all", - unique(colData(res_tmp$data_original)[,input$providedSampleAnnotationTypes]) - ), + choices = c( + "all", + unique(colData(res_tmp[[session_key]]$data_original)[,input$providedSampleAnnotationTypes]) + ), selected = "all", multiple = T ) @@ -658,17 +677,17 @@ server <- function(input,output,session){ ## Do Selection ---- selectedData <- reactive({ shiny::req(input$row_selection, input$sample_selection) - par_tmp[["row_selection"]] <<- input$row_selection + par_tmp[[session_key]][["row_selection"]] <<- input$row_selection print("Alright do Row selection") selected <- c() if(any(input$row_selection == "all")){ - selected <- rownames(rowData(res_tmp$data_original)) + selected <- rownames(rowData(res_tmp[[session_key]]$data_original)) }else if(!(length(input$row_selection) == 1 & any(input$row_selection == "High Values+IQR"))){ selected <- unique( c(selected, - rownames(rowData(res_tmp$data_original))[ - which(rowData(res_tmp$data_original)[,input$providedRowAnnotationTypes]%in%input$row_selection) + rownames(rowData(res_tmp[[session_key]]$data_original))[ + which(rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes]%in%input$row_selection) ] ) ) @@ -676,17 +695,17 @@ server <- function(input,output,session){ if(any(input$row_selection == "High Values+IQR")){ if(length(input$row_selection) == 1){ toKeep <- filter_rna( - rna = assay(res_tmp$data_original), + rna = assay(res_tmp[[session_key]]$data_original), prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] selected <- rownames(filteredIQR_Expr) }else{ toKeep <- filter_rna( - rna = assay(res_tmp$data_original)[selected,], + rna = assay(res_tmp[[session_key]]$data_original)[selected,], prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] selected <- intersect( selected, rownames(filteredIQR_Expr) @@ -698,20 +717,20 @@ server <- function(input,output,session){ # Column Selection samples_selected <- c() if(any(input$sample_selection == "all")){ - samples_selected <- colnames(assay(res_tmp$data_original)) + samples_selected <- colnames(assay(res_tmp[[session_key]]$data_original)) }else{ samples_selected <- c( samples_selected, - rownames(colData(res_tmp$data_original))[which( - colData(res_tmp$data_original)[,input$providedSampleAnnotationTypes] %in% input$sample_selection + rownames(colData(res_tmp[[session_key]]$data_original))[which( + colData(res_tmp[[session_key]]$data_original)[,input$providedSampleAnnotationTypes] %in% input$sample_selection )] ) } # Data set selection print("Alright do Column selection") - res_tmp$data <<- res_tmp$data_original[selected,samples_selected] - tmp_data_selected <<- res_tmp$data_original[selected,samples_selected] + res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data_original[selected,samples_selected] + tmp_data_selected <<- res_tmp[[session_key]]$data_original[selected,samples_selected] return("Selection Success") }) @@ -792,42 +811,42 @@ server <- function(input,output,session){ print("Do Preprocessing") print(selectedData()) addWarning <- "" - par_tmp['PreProcessing_Procedure'] <<- input$PreProcessing_Procedure + par_tmp[[session_key]]['PreProcessing_Procedure'] <<- input$PreProcessing_Procedure processedData_all <- tmp_data_selected # as general remove all genes which are constant over all rows print("As general remove all entities which are constant over all samples") - res_tmp$data <<- tmp_data_selected[rownames(tmp_data_selected[which(apply(assay(tmp_data_selected),1,sd) != 0),]),] + res_tmp[[session_key]]$data <<- tmp_data_selected[rownames(tmp_data_selected[which(apply(assay(tmp_data_selected),1,sd) != 0),]),] - print(dim(res_tmp$data)) + print(dim(res_tmp[[session_key]]$data)) # explicitly set rownames to avoid any errors. - # new object Created for res_tmp - res_tmp$data <<- res_tmp$data[rownames(res_tmp$data),] + # new object Created for res_tmp[[session_key]] + res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data[rownames(res_tmp[[session_key]]$data),] if(input$PreProcessing_Procedure != "none"){ if(input$PreProcessing_Procedure == "filterOnly"){ - if(par_tmp$omic_type == "Transcriptomics"){ + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ print("Also remove anything of rowCount <=10") print(dim(tmp_data_selected)) - res_tmp$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] + res_tmp[[session_key]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] } - if(par_tmp$omic_type == "Metabolomics"){ + if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ print("Remove anything which has a row median of 0") print(dim(tmp_data_selected)) - res_tmp$data <<- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),] + res_tmp[[session_key]]$data <<- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),] } addWarning <- "Only Filtering of low abundant is done only if Transcriptomics or Metabolomics was chosen\n" }else{ - if(par_tmp$omic_type == "Transcriptomics"){ + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ print("Also remove anything of rowCount <=10") print(dim(tmp_data_selected)) - res_tmp$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] + res_tmp[[session_key]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] } - if(par_tmp$omic_type == "Metabolomics"){ + if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ print("Remove anything which has a row median of 0") print(dim(tmp_data_selected)) @@ -835,27 +854,27 @@ server <- function(input,output,session){ } } - print(dim(res_tmp$data)) + print(dim(res_tmp[[session_key]]$data)) print(paste0("Do chosen Preprocessing:",input$PreProcessing_Procedure)) if(input$PreProcessing_Procedure == "simpleCenterScaling"){ processedData <- as.data.frame(t( scale( - x = as.data.frame(t(as.data.frame(assay(res_tmp$data)))), + x = as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data)))), scale = T, center = T ) ) ) - assay(res_tmp$data) <<- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "vst_DESeq"){ - par_tmp["DESeq_advanced"] <<- FALSE - if(par_tmp$omic_type == "Transcriptomics"){ + par_tmp[[session_key]]["DESeq_advanced"] <<- FALSE + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ design_formula <- paste("~", input$DESeq_formula_main) # only do this locally - colData(res_tmp$data)[,input$DESeq_formula_main] <- as.factor( - colData(res_tmp$data)[,input$DESeq_formula_main] + colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main] <- as.factor( + colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main] ) if(length(input$DESeq_formula_sub) > 0){ design_formula <- paste( @@ -864,63 +883,63 @@ server <- function(input,output,session){ ) # turn each factor into a factor for(i in input$DESeq_formula_sub){ - colData(res_tmp$data)[,i] <- as.factor( - colData(res_tmp$data)[,i] + colData(res_tmp[[session_key]]$data)[,i] <- as.factor( + colData(res_tmp[[session_key]]$data)[,i] ) } - par_tmp[["DESeq_factors"]] <<- c( + par_tmp[[session_key]][["DESeq_factors"]] <<- c( input$DESeq_formula_main,input$DESeq_formula_sub ) } else{ - par_tmp[["DESeq_factors"]] <<- c(input$DESeq_formula_main) + par_tmp[[session_key]][["DESeq_factors"]] <<- c(input$DESeq_formula_main) } # if advanced formula is used, overwrite the other formula if(input$DESeq_show_advanced){ if(startsWith(input$DESeq_formula_advanced, "~")){ print("Advanced formula used") design_formula <- input$DESeq_formula_advanced - par_tmp["DESeq_advanced"] <<- TRUE + par_tmp[[session_key]]["DESeq_advanced"] <<- TRUE } } print(design_formula) - par_tmp["DESeq_formula"] <<- design_formula + par_tmp[[session_key]]["DESeq_formula"] <<- design_formula # on purpose local - print(colData(res_tmp$data)[,input$DESeq_formula_main]) + print(colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main]) dds <- DESeq2::DESeqDataSetFromMatrix( - countData = assay(res_tmp$data), - colData = colData(res_tmp$data), + countData = assay(res_tmp[[session_key]]$data), + colData = colData(res_tmp[[session_key]]$data), design = as.formula(design_formula) ) de_seq_result <- DESeq2::DESeq(dds) - res_tmp$DESeq_obj <<- de_seq_result + res_tmp[[session_key]]$DESeq_obj <<- de_seq_result dds_vst <- vst( object = de_seq_result, blind = TRUE ) - assay(res_tmp$data) <<- as.data.frame(assay(dds_vst)) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(assay(dds_vst)) }else{ addWarning <- "DESeq makes only sense for transcriptomics data - data treated as if 'none' was selected!" } } if(input$PreProcessing_Procedure == "Scaling_0_1"){ processedData <- as.data.frame(t( - apply(assay(res_tmp$data),1,function(x){ + apply(assay(res_tmp[[session_key]]$data),1,function(x){ (x - min(x))/(max(x) - min(x)) }) )) - assay(res_tmp$data) <<- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "ln"){ processedData <- as.data.frame(log( - as.data.frame(assay(res_tmp$data)) + as.data.frame(assay(res_tmp[[session_key]]$data)) )) - assay(res_tmp$data) <<- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "log10"){ - processedData <- as.data.frame(assay(res_tmp$data)) + processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) if(any(processedData<0)){ addWarning <- "Negative entries, cannot take log10!!" } @@ -932,10 +951,10 @@ server <- function(input,output,session){ processedData <- as.data.frame(log10( processedData + 1) ) - assay(res_tmp$data) <<- as.data.frame(processedData) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "pareto_scaling"){ - processedData <- as.data.frame(assay(res_tmp$data)) + processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) centered <- as.data.frame(t( apply(processedData, 1, function(x){x - mean(x)}) )) @@ -943,22 +962,24 @@ server <- function(input,output,session){ apply(centered, 1, function(x){x/sqrt(sd(x))}) )) - assay(res_tmp$data) <<- as.data.frame(pareto.matrix) + assay(res_tmp[[session_key]]$data) <<- as.data.frame(pareto.matrix) } } - if(any(is.na(assay(res_tmp$data)))){ + if(any(is.na(assay(res_tmp[[session_key]]$data)))){ print("This might be problem due to mismatched Annotation Data?!") - nrow_before <- nrow(assay(res_tmp$data)) - nrow_after <- nrow(res_tmp$data[complete.cases(assay(res_tmp$data)),]) + nrow_before <- nrow(assay(res_tmp[[session_key]]$data)) + nrow_after <- nrow( + res_tmp[[session_key]]$data[complete.cases(assay(res_tmp[[session_key]]$data)),] + ) addWarning <- paste0("There were NA's after pre-processing, any row containg such was completly removed! (before/after): ",nrow_before,"/",nrow_after,"") if(!(nrow_after > 0)){ addWarning <- paste0(addWarning, "
There is nothing left, choose different pre-processing other-wise App will crash!") } - res_tmp$data <<- res_tmp$data[complete.cases(assay(res_tmp$data)),] + res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data[complete.cases(assay(res_tmp[[session_key]]$data)),] } - print(colnames(res_tmp$data)) + print(colnames(res_tmp[[session_key]]$data)) showTab(inputId = "tabsetPanel1", target = "Sample Correlation") showTab(inputId = "tabsetPanel1", target = "Significance Analysis") @@ -976,11 +997,11 @@ server <- function(input,output,session){ shinyjs::click("single_gene_visualisation-refreshUI",asis = T) paste0(addWarning, "The data has the dimensions of: ", - paste0(dim(res_tmp$data),collapse = ", "), + paste0(dim(res_tmp[[session_key]]$data),collapse = ", "), "
","Be aware that depending on omic-Type, basic pre-processing has been done anyway even when selecting none", "",ifelse(any(as.data.frame(assay(res_tmp$data)) < 0),"Be aware that processed data has negative values, hence no log fold changes can be calculated","")) + "
",ifelse(any(as.data.frame(assay(res_tmp[[session_key]]$data)) < 0),"Be aware that processed data has negative values, hence no log fold changes can be calculated","")) }) @@ -1005,9 +1026,9 @@ server <- function(input,output,session){ ## Log preprocessing ---- observeEvent(input$Do_preprocessing,{ print(selectedData_processed()) - if(par_tmp$omic_type == "Transcriptomics"){ + if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ tmp_logMessage <- "Remove anything which row Count <= 10" - }else if(par_tmp$omic_type == "Metabolomics"){ + }else if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ tmp_logMessage <- "Remove anything which has a row median of 0" }else{ tmp_logMessage <- "none" @@ -1023,19 +1044,22 @@ server <- function(input,output,session){ message = paste0("**PreProcessing** - Preprocessing procedure -specific (user-chosen): ",ifelse(input$PreProcessing_Procedure=="vst_DESeq",paste0(input$PreProcessing_Procedure, "~",input$DESeq_formula_main),input$PreProcessing_Procedure)) ) fun_LogIt( - message = paste0("**PreProcessing** - The resulting dimensions are: ",paste0(dim(res_tmp$data),collapse = ", ")) + message = paste0( + "**PreProcessing** - The resulting dimensions are: ", + paste0(dim(res_tmp[[session_key]]$data),collapse = ", ") ) + ) }) - output$debug <- renderText(dim(res_tmp$data)) + output$debug <- renderText(dim(res_tmp[[session_key]]$data)) ## UP TILL HERE ## # Sample Correlation ---- # calling server without reactive it will be init upon start, with no update # of respective data inputs hence need of at least one reactive! sample_correlation_server( id = "sample_correlation", - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(updating$count) #omic_type = reactive(input$omicType), # par_tmp$omic_type #row_select = reactive(input$row_selection) #par_tmp$row_selection ? # only for title? @@ -1044,30 +1068,30 @@ server <- function(input,output,session){ # significance analysis ---- significance_analysis_server( id = 'SignificanceAnalysis', - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(updating$count) ) # PCA ---- pca_Server( id = "PCA", - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(input$row_selection), reactive(updating$count) ) # Heatmap ---- heatmap_server( id = 'Heatmap', - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(updating$count) ) # Single Gene Visualisations ---- single_gene_visualisation_server( id = 'single_gene_visualisation', - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(updating$count) ) @@ -1075,8 +1099,8 @@ server <- function(input,output,session){ # Enrichment Analysis ---- enrichment_analysis_Server( id = 'EnrichmentAnalysis', - data = res_tmp, - params = par_tmp, + data = res_tmp[[session_key]], + params = par_tmp[[session_key]], reactive(updating$count) ) } diff --git a/program/shinyApp/www/Report.md b/program/shinyApp/www/Report.md deleted file mode 100644 index 0f617c0b..00000000 --- a/program/shinyApp/www/Report.md +++ /dev/null @@ -1,7 +0,0 @@ -**DataInput** - Uploaded Omic Type: Lipidomics - -**DataInput** - The used data was precompiled. Filename: - SHINY_LipidObsesityWTonly_precompiled 2022-06-27.rds - -**DataInput** - The raw data dimensions are:502, 42 - From 89ade1b7d99b56a0728ed362381a49345806d796 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 19 Jan 2024 12:08:54 +0100 Subject: [PATCH 2/6] Added session key as argument to functions --- program/shinyApp/R/heatmap/server.R | 6 +++--- program/shinyApp/R/pca/server.R | 4 ++-- program/shinyApp/R/pca/util.R | 2 +- program/shinyApp/R/sample_correlation/server.R | 4 ++-- program/shinyApp/R/significance_analysis/server.R | 6 +++--- program/shinyApp/R/single_gene_visualisation/server.R | 6 +++--- program/shinyApp/R/util.R | 10 ++++------ 7 files changed, 18 insertions(+), 20 deletions(-) diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R index df7b3561..c13816ce 100644 --- a/program/shinyApp/R/heatmap/server.R +++ b/program/shinyApp/R/heatmap/server.R @@ -219,9 +219,10 @@ 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, updates, heatmap_reactives$current_updates) + data <- update_data(data, session_key) 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 @@ -550,8 +551,7 @@ heatmap_server <- function(id, data, params, updates){ paste("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip", sep = "") }, content = function(file){ - envList=list( - + envList<-list( res_tmp[[session_key]]=res_tmp[[session_key]], par_tmp[[session_key]]=par_tmp[[session_key]] ) diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R index b92df35d..71a2a68c 100644 --- a/program/shinyApp/R/pca/server.R +++ b/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") + ), "PCA", session_key) 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, updates, pca_reactives$current_updates) + data2plot <- update_data(data, session_key) # select the neccesary data if(input$data_selection_pca){ data2plot <- select_data( diff --git a/program/shinyApp/R/pca/util.R b/program/shinyApp/R/pca/util.R index 702bca74..23135161 100644 --- a/program/shinyApp/R/pca/util.R +++ b/program/shinyApp/R/pca/util.R @@ -1,4 +1,4 @@ -check_calculations <- function(current_parameters, module){ +check_calculations <- function(current_parameters, module, session_key){ if (is.null(res_tmp[[session_key]][[module]])){ # chec whether result is existent return("No Result yet") } diff --git a/program/shinyApp/R/sample_correlation/server.R b/program/shinyApp/R/sample_correlation/server.R index 8d233f1e..4212398f 100644 --- a/program/shinyApp/R/sample_correlation/server.R +++ b/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(data, session_key) sample_corr_reactive$current_updates <- updates() # set the counter to 0 to prevent any further plotting sample_corr_reactive$calculate <- 0 @@ -56,7 +56,7 @@ sample_correlation_server <- function(id, data, params, updates){ preprocessing = par_tmp[[session_key]]$PreProcessing_Procedure ) ), - "SampleCorrelation" + "SampleCorrelation", session_key ) if (check == "No Result yet"){ output$SampleCorr_Info <- renderText( diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index c762a9ad..1622c0a9 100644 --- a/program/shinyApp/R/significance_analysis/server.R +++ b/program/shinyApp/R/significance_analysis/server.R @@ -181,8 +181,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(data, session_key) + params <- update_params(params, session_key) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) }) @@ -201,7 +201,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(data, session_key) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) # delete old panels diff --git a/program/shinyApp/R/single_gene_visualisation/server.R b/program/shinyApp/R/single_gene_visualisation/server.R index f0ba73e8..64d43d5e 100644 --- a/program/shinyApp/R/single_gene_visualisation/server.R +++ b/program/shinyApp/R/single_gene_visualisation/server.R @@ -16,8 +16,8 @@ single_gene_visualisation_server <- function(id, data, params, updates){ # Refresh UI /Data observeEvent(input$refreshUI,{ print("Refresh UI Single Gene") - data <- update_data(data, updates, single_Gene_vis$current_updates) - params <- update_params(params, updates, single_Gene_vis$current_updates) + data <- update_data(data, session_key) + params <- update_params(params, session_key) single_Gene_vis$current_updates <- updates() ## Ui section ---- @@ -129,7 +129,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ print(input$Select_Gene) if(single_Gene_vis$calculate == 1){ # update the data if needed - data <- update_data(data, updates, single_Gene_vis$current_updates) + data <- update_data(data, session_key) single_Gene_vis$current_updates <- updates() # set the counter to 0 to prevent any further plotting single_Gene_vis$calculate <- 0 diff --git a/program/shinyApp/R/util.R b/program/shinyApp/R/util.R index f69daaeb..58d390dd 100644 --- a/program/shinyApp/R/util.R +++ b/program/shinyApp/R/util.R @@ -1,7 +1,7 @@ ### general utility functions will be defined here -update_data <- function(data, updates, current_updates){ +update_data <- function(data, session_key){ # for stability reasons, data is ALWAYS pulled here print("Updating data...") data <- res_tmp[[session_key]] @@ -27,13 +27,11 @@ select_data <- function(data, selected_samples, sample_type){ } -update_params <- function(params, updates, current_updates){ +update_params <- function(params, session_key){ # update parameter if updates is larger than current_updates # could force to always update - if (updates() > current_updates & current_updates > 0){ - print("Updating parameters...") - params <- par_tmp[[session_key]] - } + print("Updating parameters...") + params <- par_tmp[[session_key]] return(params) } From 77a77f243e177779227739ee27e41eaccdeded4a Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 19 Jan 2024 12:13:33 +0100 Subject: [PATCH 3/6] Removed unused and unsourced function --- program/shinyApp/R/fun_getCodeSnippets.R | 802 ----------------------- 1 file changed, 802 deletions(-) delete mode 100644 program/shinyApp/R/fun_getCodeSnippets.R diff --git a/program/shinyApp/R/fun_getCodeSnippets.R b/program/shinyApp/R/fun_getCodeSnippets.R deleted file mode 100644 index 54e1f5eb..00000000 --- a/program/shinyApp/R/fun_getCodeSnippets.R +++ /dev/null @@ -1,802 +0,0 @@ - -getPlotCode <- function( - numberOfScenario, - preProcessing_Snippet = par_tmp[[session_key]]$PreProcessing_Procedure, - row_selection = par_tmp[[session_key]]$row_selection, - col_selection = par_tmp[[session_key]]$col_selection) { - #TODO change all data download to par_tmp[[session_key]] and res_tmp[[session_key]] - # Selection ---- - if(any(par_tmp[[session_key]]$row_selection == "all")){ - stringSelection <- 'selected <- rownames(rowData(res_tmp[[session_key]]$data_original)) - ' - }else{ - if(!(length(par_tmp[[session_key]]$row_selection) == 1 & any(par_tmp[[session_key]]$row_selection == "High Values+IQR"))){ - stringSelection <- 'selected <- c() -selected <- unique( - c(selected,rownames(rowData(res_tmp[[session_key]]$data_original))[ - which(rowData(res_tmp[[session_key]]$data_original) - [,par_tmp[[session_key]]$providedRowAnnotationTypes]%in%par_tmp[[session_key]]$row_selection)] - ) - ) - ' - } - if(any(par_tmp[[session_key]]$row_selection == "High Values+IQR") ){ - stringSelection <- 'toKeep <- filter_rna( - rna = assay(res_tmp[[session_key]]$data_original), - prop = par_tmp[[session_key]]$propensityChoiceUser - ) - filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] - ' - if(length(par_tmp[[session_key]]$row_selection) == 1){ - stringSelection <- paste0(stringSelection, - 'selected <- rownames(filteredIQR_Expr)') - }else{ - stringSelection <- paste0(stringSelection, - 'selected <- intersect( - selected, - rownames(filteredIQR_Expr) - )') - } - } - } - - if(par_tmp[[session_key]]$col_selection == "all"){ - stringSelection <- paste0(stringSelection,"\n", - 'samples_selected <- colnames(assay(res_tmp[[session_key]]$data_original)) - ') - }else{ - stringSelection <- paste0(stringSelection, - 'samples_selected <- c( - samples_selected, - rownames(colData(res_tmp[[session_key]]$data_original))[which( - colData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$providedSampleAnnotationTypes] %in% par_tmp[[session_key]]$sample_selection - )] - ) - ') - } - # Preprocessing ---- - - if(par_tmp[[session_key]]$PreProcessing_Procedure != "none"){ - if(par_tmp[[session_key]]$PreProcessing_Procedure == "filter_only"){ - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ - stringPreProcessing <- 'processedData <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' - } - if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ - stringPreProcessing <- 'processedData <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' - } - prequel_stringPreProcessing <- c("") - }else{ - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ - prequel_stringPreProcessing <- 'res_tmp[[session_key]]$data <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' - } - if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ - prequel_stringPreProcessing <- 'res_tmp[[session_key]]$data <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' - } - } - - if(par_tmp[[session_key]]$PreProcessing_Procedure == "simpleCenterScaling"){ - stringPreProcessing <- 'processedData <- as.data.frame(t( - scale( - x = as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data)))), - scale = T, - center = T - ) - ) - ) - assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) - ' - } - if(par_tmp[[session_key]]$PreProcessing_Procedure == "vst_DESeq"){ - stringPreProcessing <- 'dds <- DESeq2::DESeqDataSetFromMatrix( - countData = assay(res_tmp[[session_key]]$data), - colData = colData(res_tmp[[session_key]]$data), - design = as.formula(par_tmp[[session_key]]$DESeq_formula) - ) - de_seq_result <- DESeq2::DESeq(dds) - res_tmp[[session_key]]$DESeq_obj <- de_seq_result - dds_vst <- vst( - object = de_seq_result, - blind = TRUE - ) - assay(res_tmp[[session_key]]$data) <- as.data.frame(assay(dds_vst)) - ' - } - if(input$PreProcessing_Procedure == "Scaling_0_1"){ - stringPreProcessing <- 'processedData <- as.data.frame(t( - apply(assay(res_tmp[[session_key]]$data),1,function(x){ - (x - min(x))/(max(x) - min(x)) - }) - )) - assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) - ' - } - if(input$PreProcessing_Procedure == "ln"){ - stringPreProcessing <- 'processedData <- as.data.frame(log( - as.data.frame(assay(res_tmp[[session_key]]$data)) - )) - assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) - ' - } - if(input$PreProcessing_Procedure == "log10"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) - if(any(processedData==0)){ - processedData <- as.data.frame(log10( - processedData + 1) - ) - assay(res_tmp[[session_key]]$data) <- as.data.frame(processedData) - }' - } - - if(input$PreProcessing_Procedure == "pareto_scaling"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) - centered <- as.data.frame(t( - apply(processedData, 1, function(x){x - mean(x)}) - )) - pareto.matrix <- as.data.frame(t( - apply(centered, 1, function(x){x/sqrt(sd(x))}) - )) - - assay(res_tmp[[session_key]]$data) <- as.data.frame(pareto.matrix) - ' - } - stringPreProcessing <- paste0(prequel_stringPreProcessing,"\n",stringPreProcessing) - }else{ - stringPreProcessing <- '' - } - - -# Plot Code ---- - ## PCA ---- - if(numberOfScenario >= 1 & numberOfScenario < 9){ - # Calculate all necessary intermediate data sets - prequel_stringtosave <- 'pcaData <- data.frame(res_tmp[[session_key]]$PCA$x,colData(res_tmp[[session_key]]$data)) -# Annotation (important for plotly) - if(!any(colnames(pcaData) == "global_ID")){ - pcaData$global_ID <- rownames(pcaData) - } - if(!is.null(par_tmp[[session_key]]$PCA$PCA_anno_tooltip)){ - adj2colname <- gsub(" ",".",par_tmp[[session_key]]$PCA$PCA_anno_tooltip) - pcaData$chosenAnno <- pcaData[,adj2colname] - }else{ - pcaData$chosenAnno <- pcaData$global_ID - } -# Scree Plot calculations -var_explained_df <- data.frame( - PC = paste0("PC",1:ncol(res_tmp[[session_key]]$PCA$x)), - var_explained = (res_tmp[[session_key]]$PCA$sdev)^2/sum((res_tmp[[session_key]]$PCA$sdev)^2) -) -var_explained_df$Var <- paste0(round(var_explained_df$var_explained,4)*100,"%") -var_explained_df$PC <- factor(var_explained_df$PC,levels = paste0("PC",1:ncol(res_tmp[[session_key]]$PCA$x))) -percentVar <- round(100 * var_explained_df$var_explained, digits = 1) -names(percentVar)<- var_explained_df$PC - -# Loadings calculations -LoadingsDF <- data.frame( - entitie = rownames(res_tmp[[session_key]]$PCA$rotation), - Loading = res_tmp[[session_key]]$PCA$rotation[,par_tmp[[session_key]]$PCA$x_axis_selection] -) -LoadingsDF <- LoadingsDF[order(LoadingsDF$Loading,decreasing = T),] -LoadingsDF <- rbind( -LoadingsDF[nrow(LoadingsDF):(nrow(LoadingsDF) - par_tmp[[session_key]]$PCA$bottomSlider),], - LoadingsDF[par_tmp[[session_key]]$PCA$topSlider:1,] -) -LoadingsDF$entitie <- factor(LoadingsDF$entitie,levels = rownames(LoadingsDF)) -if(!is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings)){ - LoadingsDF$entitie=factor( - make.unique(as.character(rowData(res_tmp[[session_key]]$data)[rownames(LoadingsDF),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings])), - levels = make.unique(as.character(rowData(res_tmp[[session_key]]$data)[rownames(LoadingsDF),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings])) - ) -} - -df_loadings <- data.frame( - entity = row.names(res_tmp[[session_key]]$PCA$rotation), - res_tmp[[session_key]]$PCA$rotation[, 1:par_tmp[[session_key]]$PCA$nPCAs_to_look_at] -) -df_loadings_filtered <- as.matrix(df_loadings[,-1]) >= abs(par_tmp[[session_key]]$PCA$filterValue) -entitiesToInclude <- apply(df_loadings_filtered, 1, any) - -df_loadings <- df_loadings[entitiesToInclude,] %>% - tidyr::gather(key = "PC", value = "loading", -entity) - -if(!is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix)){ - df_loadings$chosenAnno <- factor( - make.unique(as.character(rowData(res_tmp[[session_key]]$data)[unique(df_loadings$entity),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix])), - levels = make.unique(as.character(rowData(res_tmp[[session_key]]$data)[unique(df_loadings$entity),par_tmp[[session_key]]$PCA$EntitieAnno_Loadings_matrix])) - ) -}else{ - df_loadings$chosenAnno <- df_loadings$entity -} -' - - if (numberOfScenario == 1) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_manual(name = par_tmp[[session_key]]$PCA$coloring_options,values=par_tmp[[session_key]]$PCA$colorTheme)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)' - } - if (numberOfScenario == 2) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_discrete(name = par_tmp[[session_key]]$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)' - } - if (numberOfScenario == 3) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_manual(values=par_tmp[[session_key]]$PCA$colorTheme, - name = par_tmp[[session_key]]$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)' - } - if (numberOfScenario == 4) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_manual(name = par_tmp[[session_key]]$PCA$coloring_options,values=par_tmp[[session_key]]$PCA$colorTheme)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], - aes(x=0, y=0, xend=v1, yend=v2), - arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), - #linetype="solid", - #alpha=0.5, - color="#ab0521")' - - - } - if (numberOfScenario == 5) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_discrete(name = par_tmp[[session_key]]$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)+ - geom_segment(data=df_out_r[which(df_out_r$feature!=""),], - aes(x=0, y=0, xend=v1, yend=v2), - arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), - #linetype="solid", - #alpha=0.5, - color="#ab0521")' - } - if (numberOfScenario == 6) { - stringtosave = 'pca_plot <- ggplot(pcaData, aes(x = pcaData[,par_tmp[[session_key]]$PCA$x_axis_selection], - y = pcaData[,par_tmp[[session_key]]$PCA$y_axis_selection], - color=pcaData[,par_tmp[[session_key]]$PCA$coloring_options], - label=global_ID, - global_ID=global_ID, - chosenAnno=chosenAnno)) + - geom_point(size =3)+ - scale_color_manual(values=par_tmp[[session_key]]$PCA$colorTheme, - name = par_tmp[[session_key]]$PCA$coloring_options)+ - xlab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$x_axis_selection]),": ",percentVar[par_tmp[[session_key]]$PCA$x_axis_selection], "% variance")) + - ylab(paste0(names(percentVar[par_tmp[[session_key]]$PCA$y_axis_selection]),": ", percentVar[par_tmp[[session_key]]$PCA$y_axis_selection], "% variance")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp[[session_key]]$PCA$customTitle)+geom_segment(data=df_out_r[which(df_out_r$feature!=""),], - aes(x=0, y=0, xend=v1, yend=v2), - arrow=arrow(type="closed",unit(0.01, "inches"),ends = "both"), - #linetype="solid", - #alpha=0.5, - color="#ab0521")' - } -### Scree - if (numberOfScenario == 7) { - stringtosave = 'scree_plot=ggplot(var_explained_df,aes(x=PC,y=var_explained, group=1))+ - geom_point(size=4,aes(label=Var))+ - geom_line()+ - ylab("Variance explained")+ - theme_bw()+ - ggtitle("Scree-Plot for shown PCA")' - } -### Loadings single - if (numberOfScenario == 8) { - stringtosave = 'plotOut=ggplot(LoadingsDF,aes(x = Loading,y = entitie)) + - geom_col(aes(fill = Loading)) + - scale_y_discrete( - breaks = LoadingsDF$entitie, - labels = stringr::str_wrap(gsub("\\\\.[0-9].*$","",LoadingsDF$entitie),20)) + - scale_fill_gradient2(low = "#277d6a",mid = "white",high = "orange") + - ylab(ifelse(is.null(par_tmp[[session_key]]$PCA$EntitieAnno_Loadings),"",par_tmp[[session_key]]$PCA$EntitieAnno_Loadings)) + - xlab(paste0("Loadings: ",par_tmp[[session_key]]$PCA$x_axis_selection)) + - theme_bw(base_size = 15)' - } -### Loadings matrix - if (numberOfScenario == 8.1) { - stringtosave = 'LoadingsMatrix <- ggplot(df_loadings, - aes(x = PC,y = chosenAnno,fill = loading)) + - geom_raster() + - scale_fill_gradientn( - colors = c("#277d6a", "white", "orange"), - limits = c(-max(df_loadings$loading),max(df_loadings$loading)) - ) + - labs(x = "PCs", y = "entity", fill = "Loading") + - theme_bw(base_size = 15)' - } - - stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave) - - } - - - ## Volcano ---- - if (numberOfScenario == 9) { - stringtosave='VolcanoPlot <- ggplot(res_tmp[[session_key]]$Volcano, - aes(label=probename,tooltip=annotation_add)) + - geom_point(aes(x = LFC,y = -log10(p_adj),colour = threshold,alpha = threshold_fc)) + - geom_hline( - yintercept = -log10(par_tmp[[session_key]]$Volcano$psig_threhsold), - color="lightgrey" - ) + - geom_vline( - xintercept = c(-par_tmp[[session_key]]$Volcano$lfc_threshold,par_tmp[[session_key]]$Volcano$lfc_threshold), - color="lightgrey" - ) + - scale_color_manual(values=par_tmp[[session_key]]$Volcano$colorScheme, name="")+ - scale_alpha_manual(values=par_tmp[[session_key]]$Volcano$alphaScheme, name="")+ - xlab("Log FoldChange")+ - ylab("-log10(p-value)")+ - theme_bw()' - } - - ## Heatmap ---- -if(numberOfScenario >= 10 & numberOfScenario <= 11){ - prequel_stringtosave <- ' -colorTheme <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c","#fdbf6f", "#ff7f00", "#fb9a99", "#e31a1c") -paletteLength <- 25 -myColor_fill <- colorRampPalette(c("blue", "white", "firebrick"))(paletteLength) - -# select and caluculate Heatmap input depending on users input - -# check par_tmp[[session_key]]$Heatmap for selected options or change accrodingly to what you desire -mycolors <- list() -if(length(par_tmp[[session_key]]$Heatmap$anno_options) == 1){ - if(length(unique(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options])) <= 8){ - names(colorTheme) <- unique(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options]) - colorTheme <- colorTheme[!is.na(names(colorTheme))] - mycolors[[par_tmp[[session_key]]$Heatmap$anno_options]] <- colorTheme - } -} - - -# Do PreSelection of input to Heatmap to show - -# selection based on row Annotation: -if(!(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "all"))){ - if(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based")){ - additionalInput_row_anno <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),"yip",NA) - if(!is.na(additionalInput_row_anno)){ - additionalInput_row_anno <- par_tmp[[session_key]]$Heatmap$anno_options_heatmap - } - additionalInput_row_anno_factor <- par_tmp[[session_key]]$Heatmap$row_anno_options_heatmap - }else{ - additionalInput_row_anno <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),par_tmp[[session_key]]$Heatmap$anno_options_heatmap,NA) - additionalInput_row_anno_factor <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options == "rowAnno_based"),c(par_tmp[[session_key]]$Heatmap$row_anno_options_heatmap),NA) - } -}else{ - additionalInput_row_anno <- "all" - additionalInput_row_anno_factor <- NA -} - -#Selection and/or ordering based on LFC -additionalInput_sample_annotation_types <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap),NA,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap) -additionalInput_ctrl_idx <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap),NA,par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap) -additionalInput_cmp_idx <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap),NA,par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap) -psig_threhsold <- ifelse(is.null(par_tmp[[session_key]]$Heatmap$psig_threhsold_heatmap),NA,par_tmp[[session_key]]$Heatmap$psig_threhsold_heatmap) - -# select TopK (if there is an ordering) -TopK2Show <- ifelse(any(par_tmp[[session_key]]$Heatmap$row_selection_options=="TopK"),par_tmp[[session_key]]$Heatmap$TopK,NA) - -if(any(par_tmp[[session_key]]$Heatmap$row_selection_options=="all")){ - print("No entitie selection") - data2HandOver <- as.data.frame(assay(res_tmp[[session_key]]$data)) -}else{ -# Note entitieSelection is a custom function -#TODO its source code file should be provided along! -entitieSelection=function(data, - type, - TopK2Show=NA, - additionalInput_row_anno=NA, - additionalInput_row_anno_factor=NA, - additionalInput_sample_annotation_types=NA, - additionalInput_ctrl_idx=NA, - additionalInput_cmp_idx=NA, - psig_threhsold=NA){ - # to cover: c("TopK","significant_LFC","LFC_onlySig","rowAnno_based") - filtered_data=assay(data) - orderMakesSense_flag=FALSE - print("Entitie Selection") - #print(additionalInput_row_anno) - if(any(type=="rowAnno_based") & !(any(is.na(additionalInput_row_anno) &is.na(additionalInput_row_anno_factor))) & !any(additionalInput_row_anno_factor=="all")){ - # Note here this only what to show, LFCs and more importantly multiple test correction will be done on the entire set (without the row anno based selection!!) - if(any(additionalInput_row_anno_factor=="all")){ - filtered_data = filtered_data - }else{ - filtered_data = filtered_data[which(data$annotation_rows[,additionalInput_row_anno] %in% additionalInput_row_anno_factor),] - } - } - if(!(is.na(additionalInput_sample_annotation_types)) & !(is.na(additionalInput_ctrl_idx)) & !(is.na(additionalInput_cmp_idx))){ - if(any(type=="significant_LFC")){ - # sort based on significance - # need LFCs - # is reachable from here? selectedData_processed()[[input$omicType]]$sample_table - ctrl_samples_idx <- which(colData(data)[,additionalInput_sample_annotation_types]%in%additionalInput_ctrl_idx) - comparison_samples_idx <- which(colData(data)[,additionalInput_sample_annotation_types]%in%additionalInput_cmp_idx) - if((length(ctrl_samples_idx) <= 1) | (length(comparison_samples_idx) <= 1)){ - warning("LFC makes no sense just having a single sample per conidition, which is here the case!") - filtered_data=NULL - }else{ - LFC_output=getLFC(filtered_data,ctrl_samples_idx,comparison_samples_idx) - filtered_data=filtered_data[rownames(LFC_output)[order(LFC_output$p_adj,decreasing = F)],,drop=F] - orderMakesSense_flag=T - } - - } - if(any(type=="LFC_onlySig")){ - ctrl_samples_idx<-which(colData(data)[,additionalInput_sample_annotation_types]%in%additionalInput_ctrl_idx) - comparison_samples_idx<-which(colData(data)[,additionalInput_sample_annotation_types]%in%additionalInput_cmp_idx) - LFC_output=getLFC(filtered_data,ctrl_samples_idx,comparison_samples_idx) - if(!(any(LFC_output$p_adj can we speak from here to output$debug? - filtered_data=NULL - }else{ - filtered_data=filtered_data[rownames(LFC_output)[which(LFC_output$p_adjTopK2Show){ - filtered_data=filtered_data[c(1:TopK2Show),,drop=F] - }else{ - filtered_data=filtered_data - } - }else{ - filtered_data=NULL - } - - } - - - - return(filtered_data) - } - -# get LFC -getLFC <- function( - data, - ctrl_samples_idx, - comparison_samples_idx, - completeOutput = FALSE -){ - df <- as.data.frame(data) - # Todo by @Lea: discuss and finalize how to handle this. constant row are not removed but small noise is added should in here a check if all 0 rows? - ttest_raw <- function(df, grp1, grp2) { - x <- df[grp1] - y <- df[grp2] - x <- as.numeric(x) - y <- as.numeric(y) - results <- t.test(x, y) - return(results$p.value) - } - #remove constant rows - removedAsConst_1 <- which(apply(df[,ctrl_samples_idx],1,sd) < 1e-6) - df[removedAsConst_1,ctrl_samples_idx] <- df[removedAsConst_1,ctrl_samples_idx] + t(apply(df[removedAsConst_1,ctrl_samples_idx],1,function(x){ - rnorm( - n = length(x), - mean = 0, - sd=0.0000001 - )})) - - removedAsConst_2 <- which(apply(df[,comparison_samples_idx],1,sd) < 1e-6) - df[removedAsConst_2,comparison_samples_idx] <- df[removedAsConst_2,comparison_samples_idx] + t(apply(df[removedAsConst_2,comparison_samples_idx],1,function(x){ - rnorm( - n = length(x), - mean = 0, - sd=0.0000001 - )})) - - - rawpvalue <- apply(df, 1, ttest_raw, grp1 = ctrl_samples_idx, grp2 = comparison_samples_idx) - - p_adj <- p.adjust(rawpvalue, method = "fdr") - - Ctrl_mean <- apply(df[,ctrl_samples_idx],1,mean) - Cmp_mean <- apply(df[,comparison_samples_idx],1,mean) - - FC <- Cmp_mean/Ctrl_mean - - LFC <- log2(FC) - - # Data 2 Plot - results <- cbind(LFC, rawpvalue,p_adj) - results <- as.data.frame(results) - results$probename <- rownames(results) - if(completeOutput){ - # report results table + inital values that where used to calculate (mostly - # for sainity checks) - colnames(df)[ctrl_samples_idx]=paste0(colnames(df)[ctrl_samples_idx],"_ctrl") - colnames(df)[comparison_samples_idx]=paste0(colnames(df)[comparison_samples_idx],"_cmp") - results=cbind(results,df[rownames(df),]) - } - return(results) -} - - - data2HandOver <- entitieSelection( - res_tmp[[session_key]]$data, - type = par_tmp[[session_key]]$Heatmap$row_selection_options, - additionalInput_row_anno = additionalInput_row_anno, - additionalInput_row_anno_factor = additionalInput_row_anno_factor, - additionalInput_sample_annotation_types = additionalInput_sample_annotation_types, - additionalInput_ctrl_idx = additionalInput_ctrl_idx, - additionalInput_cmp_idx = additionalInput_cmp_idx, - psig_threhsold = psig_threhsold, - TopK2Show = TopK2Show - ) -} - -doThis_flag <- T -if(is.null(data2HandOver)){ - print("Nothing is left,e.g. no significant Terms or TopK is used but no inherent order of the data") - heatmap_plot <- NULL - doThis_flag <- F -} -' - - if(numberOfScenario == 10){ - stringtosave <- ' -annotation_col <- rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] - -ctrl_samples_idx <- which( - colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp[[session_key]]$Heatmap$Groups2Compare_ref_heatmap - ) -comparison_samples_idx <- which( - colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp[[session_key]]$Heatmap$Groups2Compare_treat_heatmap -) -if(length(comparison_samples_idx) <=1 | length(ctrl_samples_idx) <=1){ - print("Choose variable with at least two samples per condition!") - doThis_flag <- F -} - -if(par_tmp[[session_key]]$PreProcessing_Procedure == "simpleCenterScaling"| any(data2HandOver)< 0){ - print("Remember do not use normal center + scaling (negative Values!)") -}else if(doThis_flag){ - Data2Plot <- getLFC( - data = as.data.frame(data2HandOver), - ctrl_samples_idx = ctrl_samples_idx, - comparison_samples_idx = comparison_samples_idx - ) - -if(par_tmp[[session_key]]$Heatmap$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))) - annotation_col <- rowData(res_tmp[[session_key]]$data)[rownames(Data2Plot),par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] -} - - -heatmap_plot <- pheatmap((t(Data2Plot[,"LFC",drop=F])), - main="Heatmap - LFC", - show_rownames=ifelse(nrow(Data2Plot)<=25,TRUE,FALSE), - show_colnames=TRUE, - cluster_cols = par_tmp[[session_key]]$Heatmap$cluster_cols, - cluster_rows = FALSE, # par_tmp[[session_key]]$Heatmap$cluster_rows, - scale=ifelse(par_tmp[[session_key]]$Heatmap$rowWiseScaled,"row","none"), - # cutree_cols = 4, - #fontsize = font.size, - annotation_col = annotation_col, - - silent = F, - breaks = myBreaks, - color = myColor_fill)' - } - if(numberOfScenario == 11){ - stringtosave <- ' -annotation_col <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$anno_options,drop=F] -annotation_row <- rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$Heatmap$row_anno_options,drop=F] -# convert both to data.frame -annotation_col <- as.data.frame(annotation_col) -annotation_row <- as.data.frame(annotation_row) - -clusterRowspossible <- ifelse(nrow(as.matrix(assay(res_tmp[[session_key]]$data)))>1,par_tmp[[session_key]]$Heatmap$cluster_rows,F) - -heatmap_plot <- pheatmap(as.matrix(res_tmp[[session_key]]$Heatmap), - main="Heatmap", - show_rownames=ifelse(nrow((assay(res_tmp[[session_key]]$data)))<=par_tmp[[session_key]]$Heatmap$row_label_no,TRUE,FALSE), - labels_row = rowData(res_tmp[[session_key]]$data)[rownames(assay(res_tmp[[session_key]]$data)),par_tmp[[session_key]]$Heatmap$row_label_options], - show_colnames=TRUE, - cluster_cols = par_tmp[[session_key]]$Heatmap$cluster_cols, - cluster_rows = clusterRowspossible, - scale=ifelse(par_tmp[[session_key]]$Heatmap$rowWiseScaled,"row","none"), - # cutree_cols = 4, - #fontsize = font.size, - annotation_col = annotation_col, - annotation_row =annotation_row, - annotation_colors = mycolors, - silent = F)' - } -stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave) -} - - - -## Single Gene Visualisation ---- -if(numberOfScenario %in% c(12,13)){ - if(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene == "preprocessed"){ - prequel_stringtosave <- '#get IDX to data -idx_selected <- which(par_tmp[[session_key]]$SingleEntVis$Select_Gene == rowData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$Select_GeneAnno]) -GeneData <- as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data))[idx_selected,,drop=F])) -GeneData$anno <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$accross_condition] -if(length(idx_selected)>1){ - # summarise the data - GeneData_medians <- rowMedians(as.matrix(GeneData[,-ncol(GeneData)])) - GeneData <- GeneData[,ncol(GeneData),drop=F] - GeneData$rowMedian <- GeneData_medians - GeneData <- GeneData[,c("rowMedian","anno")] -} -GeneData$anno <- as.factor(GeneData$anno) - ' - }else if(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene == "raw" ){ - prequel_stringtosave <- '#get IDX to data -idx_selected <- which(par_tmp[[session_key]]$SingleEntVis$Select_Gene == rowData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$SingleEntVis$Select_GeneAnno]) -GeneData <- as.data.frame(t(assay(res_tmp[[session_key]]$data_original)[idx_selected,,drop=F])) -GeneData$anno <- colData(res_tmp[[session_key]]$data_original)[,par_tmp[[session_key]]$SingleEntVis$accross_condition] -# select to selection of processed data -annoToSelect=unique(c(colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SingleEntVis$accross_condition])) -GeneData = subset(GeneData, anno %in% annoToSelect) -if(length(idx_selected)>1){ - # summarise the data - GeneData_medians <- rowMedians(as.matrix(GeneData[,-ncol(GeneData)])) - GeneData <- GeneData[,ncol(GeneData),drop=F] - GeneData$rowMedian <- GeneData_medians - GeneData <- GeneData[,c("rowMedian","anno")] - } -GeneData$anno <- as.factor(GeneData$anno) - ' - } - - if (numberOfScenario == 12) { - stringtosave = '# GeneData now contains the same as res_tmp[[session_key]]$SingleEntVis -P_boxplots <- ggplot(res_tmp[[session_key]]$SingleEntVis, - aes(y=res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]], - x=anno, - fill=anno))+ - geom_boxplot()+ # unable if less then 4 samples in all groups to get the same plot as in the App - geom_point(shape = 21,size=5)+ - scale_fill_brewer(palette="RdBu")+ - xlab(par_tmp[[session_key]]$SingleEntVis$Select_Gene)+ - ylab(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene)+ - theme_bw()+ - geom_hline(yintercept = mean(res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]]), linetype = 2)+ # Add horizontal line at base mean - #stat_compare_means(method = "anova")+ # Add global annova p-value - stat_compare_means(comparisons = par_tmp[[session_key]]$SingleEntVis$chooseComparisons_list, - method = par_tmp[[session_key]]$SingleEntVis$testMethod, - label = "p.signif", - hide.ns = TRUE)' - } - if (numberOfScenario == 13) { - stringtosave = '# GeneData now contains the same as res_tmp[[session_key]]$SingleEntVis -P_boxplots <- ggplot(res_tmp[[session_key]]$SingleEntVis, - aes(y=res_tmp[[session_key]]$SingleEntVis[,colnames(res_tmp[[session_key]]$SingleEntVis)[-ncol(res_tmp[[session_key]]$SingleEntVis)]], - x=anno, - fill=anno))+ - geom_boxplot()+# unable if less then 4 samples in all groups to get the same plot as in the App - geom_point(shape = 21,size=5)+ - scale_fill_brewer(palette="RdBu")+ - xlab(par_tmp[[session_key]]$SingleEntVis$Select_Gene)+ - ylab(par_tmp[[session_key]]$SingleEntVis$type_of_data_gene)+ - theme_bw()' - } - stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave) -} - - ## TODO ensure this remains working with new output from Enrichment, needs a potential update! - if(numberOfScenario == 14){ - stringtosave = 'KEGG_Plot_GSE=clusterProfiler::dotplot(EnrichmentRes_Kegg,split=".sign") + - facet_grid(.~.sign)' - } - if(numberOfScenario==15){ - stringtosave = 'KEGG_Plot_ORA=clusterProfiler::dotplot(EnrichmentRes_Kegg)' - } - if(numberOfScenario==16){ - stringtosave='GO_Plot=clusterProfiler::dotplot(EnrichmentRes_GO)' - } - if(numberOfScenario == 17){ - stringtosave='REACTOME_Plot=clusterProfiler::dotplot(EnrichmentRes_RACTOME)' - } - -## Sample Correlation plot ---- - if(numberOfScenario == 18){ - stringtosave = 'annotationDF <- colData(res_tmp[[session_key]]$data)[,par_tmp[[session_key]]$SampleCorr$SampleAnnotationChoice,drop = F] -cormat <- cor( - x = as.matrix(assay(res_tmp[[session_key]]$data)), - method = par_tmp[[session_key]]$SampleCorr$corrMethod -) - -SampleCorrelationPlot <- pheatmap( -mat = cormat, #res_tmp[[session_key]]$SampleCorr -annotation_row = par_tmp[[session_key]]$SampleCorr$annotationDF, -main = par_tmp[[session_key]]$SampleCorr$customTitleSampleCorrelation, -annotation_colors = par_tmp[[session_key]]$SampleCorr$anno_colors -)' - } -## Significance Analysis ----- -### Venn Diagram ---- - if(numberOfScenario == 20){ - stringtosave <- 'VennDiagramm <- ggVennDiagram::ggVennDiagram(res_tmp[[session_key]]$SignificanceAnalysis)' - } -### Upset plot ---- - if(numberOfScenario == 21){ - stringtosave <- 'UpSetR::upset(fromList(res_tmp[[session_key]]$SignificanceAnalysis))' - } - -### Volcano ---- - - - - - - if(numberOfScenario == 0){ - stringtosave <- '# No_code_yet' - } - - return(paste0(CODE_DOWNLOAD_PREFACE, - "\n", - stringSelection, - CODE_DOWNLOAD_SELECTION, - "\n", - CODE_DOWNLOAD_PREPROCESSING, - "\n", - stringPreProcessing, - "\n", - stringtosave)) -} From 3787a112ce52f80dc4ece27dbf03f361c3d53b93 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 19 Jan 2024 13:37:27 +0100 Subject: [PATCH 4/6] Working example with session id. Needs to be tested on server side. --- .../enrichment_analysis/enrichment_analysis.R | 232 ++++++++--------- .../overrepresentation_analysis.R | 240 +++++++++--------- .../shinyApp/R/enrichment_analysis/server.R | 4 +- program/shinyApp/R/heatmap/server.R | 55 ++-- program/shinyApp/R/pca/server.R | 8 +- program/shinyApp/R/pca/util.R | 6 +- .../shinyApp/R/sample_correlation/server.R | 38 +-- .../shinyApp/R/significance_analysis/server.R | 16 +- .../shinyApp/R/significance_analysis/util.R | 14 +- .../R/single_gene_visualisation/server.R | 36 +-- program/shinyApp/R/util.R | 8 +- program/shinyApp/server.R | 218 ++++++++-------- program/shinyApp/ui.R | 7 + 13 files changed, 448 insertions(+), 434 deletions(-) diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R index 0becf147..3ffad644 100644 --- a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R @@ -49,7 +49,7 @@ gene_set_enrichment <- function( if(enrichments2do$KEGG){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$KEGG )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -64,15 +64,15 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG <<- EnrichmentRes_Kegg - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$KEGG <<- EnrichmentRes_Kegg + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$KEGG <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_Kegg <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$KEGG + EnrichmentRes_Kegg <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$KEGG } } if(enrichments2do$GO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO )) ){ EnrichmentRes_GO <- clusterProfiler::gseGO( gene = geneSetChoice, @@ -85,16 +85,16 @@ gene_set_enrichment <- function( OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db"), pAdjustMethod = "none" # TODO: discuss ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO + EnrichmentRes_GO <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO } } # Hallmarks if(enrichments2do$Hallmarks){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$Hallmarks )) ){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -108,16 +108,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks <<- EnrichmentRes_Hallmarks - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$Hallmarks <<- EnrichmentRes_Hallmarks + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$Hallmarks <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_Hallmarks <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$Hallmarks + EnrichmentRes_Hallmarks <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$Hallmarks } } # C1 if(enrichments2do$C1){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C1 )) ){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -131,17 +131,17 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 <<- EnrichmentRes_C1 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C1 <<- EnrichmentRes_C1 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C1 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C1 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C1 + EnrichmentRes_C1 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C1 } } # C2 if(enrichments2do$C2){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C2 )) ){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -155,16 +155,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 <<- EnrichmentRes_C2 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C2 <<- EnrichmentRes_C2 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C2 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C2 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C2 + EnrichmentRes_C2 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C2 } } # C3 if(enrichments2do$C3){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C3 )) ){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -178,16 +178,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 <<- EnrichmentRes_C3 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C3 <<- EnrichmentRes_C3 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C3 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C3 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C3 + EnrichmentRes_C3 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C3 } } # C4 if(enrichments2do$C4){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C4 )) ){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -201,16 +201,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 <<- EnrichmentRes_C4 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C4 <<- EnrichmentRes_C4 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C4 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C4 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C4 + EnrichmentRes_C4 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C4 } } # C5 if(enrichments2do$C5){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C5 )) ){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -224,16 +224,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 <<- EnrichmentRes_C5 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C5 <<- EnrichmentRes_C5 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C5 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C5 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C5 + EnrichmentRes_C5 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C5 } } # C6 if(enrichments2do$C6){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C6 )) ){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -247,16 +247,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 <<- EnrichmentRes_C6 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C6 <<- EnrichmentRes_C6 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C6 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C6 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C6 + EnrichmentRes_C6 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C6 } } # C7 if(enrichments2do$C7){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C7 )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -270,16 +270,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 <<- EnrichmentRes_C7 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C7 <<- EnrichmentRes_C7 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C7 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C7 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C7 + EnrichmentRes_C7 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C7 } } # C8 if(enrichments2do$C8){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C8 )) ){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -293,16 +293,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 <<- EnrichmentRes_C8 - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C8 <<- EnrichmentRes_C8 + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C8 <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_C8 <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$C8 + EnrichmentRes_C8 <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$C8 } } # C2 subset CGP if(enrichments2do$CGP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -317,16 +317,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP <<- EnrichmentRes_CGP - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGP <<- EnrichmentRes_CGP + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CGP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGP + EnrichmentRes_CGP <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGP } } # C2 subset CP if(enrichments2do$CP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -341,16 +341,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP <<- EnrichmentRes_CP - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CP <<- EnrichmentRes_CP + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CP + EnrichmentRes_CP <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CP } } # C2:CP subset BIOCARTA if(enrichments2do$BIOCARTA){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$BIOCARTA )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -365,16 +365,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- EnrichmentRes_BIOCARTA - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- EnrichmentRes_BIOCARTA + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$BIOCARTA <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_BIOCARTA <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$BIOCARTA + EnrichmentRes_BIOCARTA <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$BIOCARTA } } # C2:CP subset PID if(enrichments2do$PID){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$PID )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -389,16 +389,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID <<- EnrichmentRes_PID - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$PID <<- EnrichmentRes_PID + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$PID <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_PID <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$PID + EnrichmentRes_PID <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$PID } } # C2:CP subset REACTOME if(enrichments2do$REACTOME){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$REACTOME )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -413,16 +413,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME <<- EnrichmentRes_REACTOME - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$REACTOME <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_REACTOME <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$REACTOME } } # C2:CP subset WIKIPATHWAYS if(enrichments2do$WIKIPATHWAYS){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -437,16 +437,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS + EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$WIKIPATHWAYS } } # C3 subset MIR:MIRDB if(enrichments2do$MIRDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIRDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -461,16 +461,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB <<- EnrichmentRes_MIRDB - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIRDB <<- EnrichmentRes_MIRDB + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIRDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_MIRDB <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIRDB + EnrichmentRes_MIRDB <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIRDB } } # C3 subset MIR:MIR_Legacy if(enrichments2do$MIR_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIR_Legacy )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -485,16 +485,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- EnrichmentRes_MIR_Legacy - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- EnrichmentRes_MIR_Legacy + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIR_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_MIR_Legacy <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$MIR_Legacy + EnrichmentRes_MIR_Legacy <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$MIR_Legacy } } # C3 subset TFT:GTRD if(enrichments2do$GTRD){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GTRD )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -509,16 +509,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD <<- EnrichmentRes_GTRD - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GTRD <<- EnrichmentRes_GTRD + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GTRD <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GTRD <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GTRD + EnrichmentRes_GTRD <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GTRD } } # C3 subset TFT:TFT_Legacy if(enrichments2do$TFT_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$TFT_Legacy )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -533,16 +533,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- EnrichmentRes_TFT_Legacy - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- EnrichmentRes_TFT_Legacy + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$TFT_Legacy <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_TFT_Legacy <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$TFT_Legacy + EnrichmentRes_TFT_Legacy <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$TFT_Legacy } } # C4 subset CGN if(enrichments2do$CGN){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGN )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -557,16 +557,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN <<- EnrichmentRes_CGN - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGN <<- EnrichmentRes_CGN + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGN <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CGN <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CGN + EnrichmentRes_CGN <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CGN } } # C4 subset CM if(enrichments2do$CM){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CM )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -581,16 +581,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM <<- EnrichmentRes_CM - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CM <<- EnrichmentRes_CM + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CM <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_CM <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$CM + EnrichmentRes_CM <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$CM } } # C5 subset GO BP if(enrichments2do$GO_BP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_BP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -605,16 +605,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP <<- EnrichmentRes_GO_BP - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_BP <<- EnrichmentRes_GO_BP + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_BP <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_BP <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_BP + EnrichmentRes_GO_BP <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_BP } } # C5 subset GO CC if(enrichments2do$GO_CC){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_CC )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -629,16 +629,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC <<- EnrichmentRes_GO_CC - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_CC <<- EnrichmentRes_GO_CC + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_CC <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_CC <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_CC + EnrichmentRes_GO_CC <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_CC } } # C5 subset GO MF if(enrichments2do$GO_MF){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_MF )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -653,16 +653,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF <<- EnrichmentRes_GO_MF - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_MF <<- EnrichmentRes_GO_MF + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_MF <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_GO_MF <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$GO_MF + EnrichmentRes_GO_MF <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$GO_MF } } # C5 subset HPO if(enrichments2do$HPO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$HPO )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -677,16 +677,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO <<- EnrichmentRes_HPO - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$HPO <<- EnrichmentRes_HPO + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$HPO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_HPO <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$HPO + EnrichmentRes_HPO <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$HPO } } # C7 subset IMMUNESIGDB if(enrichments2do$IMMUNESIGDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -701,16 +701,16 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_IMMUNESIGDB <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB + EnrichmentRes_IMMUNESIGDB <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$IMMUNESIGDB } } # C7 subset VAX if(enrichments2do$VAX){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$VAX )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -725,10 +725,10 @@ gene_set_enrichment <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], pvalueCutoff = 1 ) - res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX <<- EnrichmentRes_VAX - par_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX <<- list("adjustMethod"=adjustMethod, "sort"=sorting) + res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$VAX <<- EnrichmentRes_VAX + par_tmp[[session$token]]$EA[[comp_type]][[contrast]]$VAX <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - EnrichmentRes_VAX <- res_tmp[[session_key]]$EA[[comp_type]][[contrast]]$VAX + EnrichmentRes_VAX <- res_tmp[[session$token]]$EA[[comp_type]][[contrast]]$VAX } } diff --git a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R index b44aa296..1b65cacf 100644 --- a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R @@ -67,37 +67,37 @@ over_representation_analysis <- function( EnrichmentRes_C8 <- NULL # KEGG if(enrichments2do$KEGG){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$KEGG ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$KEGG ))){ EnrichmentRes_KEGG <- clusterProfiler::enrichKEGG( gene = geneSetChoice, organism = input$OrganismChoice, pvalueCutoff = 0.05, universe = universeSelected_tranlsated ) - res_tmp[[session_key]]$OA$KEGG <<- EnrichmentRes_KEGG - par_tmp[[session_key]]$OA$KEGG <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$KEGG <<- EnrichmentRes_KEGG + par_tmp[[session$token]]$OA$KEGG <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_KEGG <- res_tmp[[session_key]]$OA$KEGG + EnrichmentRes_KEGG <- res_tmp[[session$token]]$OA$KEGG } } # GO if(enrichments2do$GO){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$GO ))){ EnrichmentRes_GO <- clusterProfiler::enrichGO( gene = geneSetChoice, ont = input$ontologyForGO, pvalueCutoff = 0.05, OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db") ) - res_tmp[[session_key]]$OA$GO <<- EnrichmentRes_GO - par_tmp[[session_key]]$OA$GO <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$GO <<- EnrichmentRes_GO + par_tmp[[session$token]]$OA$GO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO <- res_tmp[[session_key]]$OA$GO + EnrichmentRes_GO <- res_tmp[[session$token]]$OA$GO } } # Reactome if(enrichments2do$REACTOME){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$REACTOME ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$REACTOME ))){ EnrichmentRes_REACTOME <- ReactomePA::enrichPathway( gene = geneSetChoice, pvalueCutoff = 0.05, @@ -105,15 +105,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, readable = T ) - res_tmp[[session_key]]$OA$REACTOME <<- EnrichmentRes_REACTOME - par_tmp[[session_key]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session$token]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp[[session_key]]$OA$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session$token]]$OA$REACTOME } } # Hallmarks if(enrichments2do$Hallmarks){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$Hallmarks ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$Hallmarks ))){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "H", @@ -125,15 +125,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = Hallmarkset ) - res_tmp[[session_key]]$OA$Hallmarks <<- EnrichmentRes_Hallmarks - par_tmp[[session_key]]$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$Hallmarks <<- EnrichmentRes_Hallmarks + par_tmp[[session$token]]$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_Hallmarks <- res_tmp[[session_key]]$OA$Hallmarks + EnrichmentRes_Hallmarks <- res_tmp[[session$token]]$OA$Hallmarks } } # C1 if(enrichments2do$C1){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C1 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C1 ))){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C1", @@ -145,15 +145,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C1set ) - res_tmp[[session_key]]$OA$C1 <<- EnrichmentRes_C1 - par_tmp[[session_key]]$OA$C1 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C1 <<- EnrichmentRes_C1 + par_tmp[[session$token]]$OA$C1 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C1 <- res_tmp[[session_key]]$OA$C1 + EnrichmentRes_C1 <- res_tmp[[session$token]]$OA$C1 } } # C2 if(enrichments2do$C2){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C2 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C2 ))){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -165,15 +165,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C2set ) - res_tmp[[session_key]]$OA$C2 <<- EnrichmentRes_C2 - par_tmp[[session_key]]$OA$C2 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C2 <<- EnrichmentRes_C2 + par_tmp[[session$token]]$OA$C2 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C2 <- res_tmp[[session_key]]$OA$C2 + EnrichmentRes_C2 <- res_tmp[[session$token]]$OA$C2 } } # C3 if(enrichments2do$C3){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C3 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C3 ))){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -185,15 +185,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C3set ) - res_tmp[[session_key]]$OA$C3 <<- EnrichmentRes_C3 - par_tmp[[session_key]]$OA$C3 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C3 <<- EnrichmentRes_C3 + par_tmp[[session$token]]$OA$C3 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C3 <- res_tmp[[session_key]]$OA$C3 + EnrichmentRes_C3 <- res_tmp[[session$token]]$OA$C3 } } # C4 if(enrichments2do$C4){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C4 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C4 ))){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -205,15 +205,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C4set ) - res_tmp[[session_key]]$OA$C4 <<- EnrichmentRes_C4 - par_tmp[[session_key]]$OA$C4 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C4 <<- EnrichmentRes_C4 + par_tmp[[session$token]]$OA$C4 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C4 <- res_tmp[[session_key]]$OA$C4 + EnrichmentRes_C4 <- res_tmp[[session$token]]$OA$C4 } } # C5 if(enrichments2do$C5){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C5 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C5 ))){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -225,15 +225,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C5set ) - res_tmp[[session_key]]$OA$C5 <<- EnrichmentRes_C5 - par_tmp[[session_key]]$OA$C5 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C5 <<- EnrichmentRes_C5 + par_tmp[[session$token]]$OA$C5 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C5 <- res_tmp[[session_key]]$OA$C5 + EnrichmentRes_C5 <- res_tmp[[session$token]]$OA$C5 } } # C6 if(enrichments2do$C6){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C6 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C6 ))){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C6", @@ -245,15 +245,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C6set ) - res_tmp[[session_key]]$OA$C6 <<- EnrichmentRes_C6 - par_tmp[[session_key]]$OA$C6 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C6 <<- EnrichmentRes_C6 + par_tmp[[session$token]]$OA$C6 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C6 <- res_tmp[[session_key]]$OA$C6 + EnrichmentRes_C6 <- res_tmp[[session$token]]$OA$C6 } } # C7 ImmuneSigDB subset if(enrichments2do$C7){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C7 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C7 ))){ C7set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -266,15 +266,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C7set ) - res_tmp[[session_key]]$OA$C7 <<- EnrichmentRes_C7 - par_tmp[[session_key]]$OA$C7 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C7 <<- EnrichmentRes_C7 + par_tmp[[session$token]]$OA$C7 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C7 <- res_tmp[[session_key]]$OA$C7 + EnrichmentRes_C7 <- res_tmp[[session$token]]$OA$C7 } } # C8 if(enrichments2do$C8){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$C8 ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$C8 ))){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C8", @@ -286,15 +286,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = C8set ) - res_tmp[[session_key]]$OA$C8 <<- EnrichmentRes_C8 - par_tmp[[session_key]]$OA$C8 <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$C8 <<- EnrichmentRes_C8 + par_tmp[[session$token]]$OA$C8 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C8 <- res_tmp[[session_key]]$OA$C8 + EnrichmentRes_C8 <- res_tmp[[session$token]]$OA$C8 } } # C2 subset CGP if(enrichments2do$CGP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CGP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$CGP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -307,15 +307,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$CGP <<- EnrichmentRes_CGP - par_tmp[[session_key]]$OA$CGP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$CGP <<- EnrichmentRes_CGP + par_tmp[[session$token]]$OA$CGP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGP <- res_tmp[[session_key]]$OA$CGP + EnrichmentRes_CGP <- res_tmp[[session$token]]$OA$CGP } } # C2 subset CP if(enrichments2do$CP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$CP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -328,15 +328,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$CP <<- EnrichmentRes_CP - par_tmp[[session_key]]$OA$CP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$CP <<- EnrichmentRes_CP + par_tmp[[session$token]]$OA$CP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CP <- res_tmp[[session_key]]$OA$CP + EnrichmentRes_CP <- res_tmp[[session$token]]$OA$CP } } # C2:CP subset BIOCARTA if(enrichments2do$BIOCARTA){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$BIOCARTA ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$BIOCARTA ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -349,15 +349,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA - par_tmp[[session_key]]$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA + par_tmp[[session$token]]$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_BIOCARTA <- res_tmp[[session_key]]$OA$BIOCARTA + EnrichmentRes_BIOCARTA <- res_tmp[[session$token]]$OA$BIOCARTA } } # C2:CP subset PID if(enrichments2do$PID){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$PID ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$PID ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -370,15 +370,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$PID <<- EnrichmentRes_PID - par_tmp[[session_key]]$OA$PID <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$PID <<- EnrichmentRes_PID + par_tmp[[session$token]]$OA$PID <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_PID <- res_tmp[[session_key]]$OA$PID + EnrichmentRes_PID <- res_tmp[[session$token]]$OA$PID } } # C2:CP subset REACTOME if(enrichments2do$REACTOME){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$REACTOME ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$REACTOME ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -391,15 +391,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$REACTOME <<- EnrichmentRes_REACTOME - par_tmp[[session_key]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session$token]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp[[session_key]]$OA$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session$token]]$OA$REACTOME } } # C2:CP subset WIKIPATHWAYS if(enrichments2do$WIKIPATHWAYS){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$WIKIPATHWAYS ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$WIKIPATHWAYS ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -412,15 +412,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS - par_tmp[[session_key]]$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS + par_tmp[[session$token]]$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session_key]]$OA$WIKIPATHWAYS + EnrichmentRes_WIKIPATHWAYS <- res_tmp[[session$token]]$OA$WIKIPATHWAYS } } # C3 subset MIR:MIRDB if(enrichments2do$MIRDB){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$MIRDB ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$MIRDB ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -433,15 +433,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$MIRDB <<- EnrichmentRes_MIRDB - par_tmp[[session_key]]$OA$MIRDB <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$MIRDB <<- EnrichmentRes_MIRDB + par_tmp[[session$token]]$OA$MIRDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIRDB <- res_tmp[[session_key]]$OA$MIRDB + EnrichmentRes_MIRDB <- res_tmp[[session$token]]$OA$MIRDB } } # C3 subset MIR:MIR_Legacy if(enrichments2do$MIR_Legacy){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$MIR_Legacy ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$MIR_Legacy ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -454,15 +454,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy - par_tmp[[session_key]]$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy + par_tmp[[session$token]]$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIR_Legacy <- res_tmp[[session_key]]$OA$MIR_Legacy + EnrichmentRes_MIR_Legacy <- res_tmp[[session$token]]$OA$MIR_Legacy } } # C3 subset TFT:GTRD if(enrichments2do$GTRD){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GTRD ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$GTRD ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -475,15 +475,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$GTRD <<- EnrichmentRes_GTRD - par_tmp[[session_key]]$OA$GTRD <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$GTRD <<- EnrichmentRes_GTRD + par_tmp[[session$token]]$OA$GTRD <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GTRD <- res_tmp[[session_key]]$OA$GTRD + EnrichmentRes_GTRD <- res_tmp[[session$token]]$OA$GTRD } } # C3 subset TFT:TFT_Legacy if(enrichments2do$TFT_Legacy){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$TFT_Legacy ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$TFT_Legacy ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -496,15 +496,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy - par_tmp[[session_key]]$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy + par_tmp[[session$token]]$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_TFT_Legacy <- res_tmp[[session_key]]$OA$TFT_Legacy + EnrichmentRes_TFT_Legacy <- res_tmp[[session$token]]$OA$TFT_Legacy } } # C4 subset CGN if(enrichments2do$CGN){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CGN ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$CGN ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -517,15 +517,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$CGN <<- EnrichmentRes_CGN - par_tmp[[session_key]]$OA$CGN <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$CGN <<- EnrichmentRes_CGN + par_tmp[[session$token]]$OA$CGN <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGN <- res_tmp[[session_key]]$OA$CGN + EnrichmentRes_CGN <- res_tmp[[session$token]]$OA$CGN } } # C4 subset CM if(enrichments2do$CM){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$CM ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$CM ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -538,15 +538,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$CM <<- EnrichmentRes_CM - par_tmp[[session_key]]$OA$CM <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$CM <<- EnrichmentRes_CM + par_tmp[[session$token]]$OA$CM <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CM <- res_tmp[[session_key]]$OA$CM + EnrichmentRes_CM <- res_tmp[[session$token]]$OA$CM } } # C5 subset GO BP if(enrichments2do$GO_BP){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_BP ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$GO_BP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -559,15 +559,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$GO_BP <<- EnrichmentRes_GO_BP - par_tmp[[session_key]]$OA$GO_BP <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$GO_BP <<- EnrichmentRes_GO_BP + par_tmp[[session$token]]$OA$GO_BP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_BP <- res_tmp[[session_key]]$OA$GO_BP + EnrichmentRes_GO_BP <- res_tmp[[session$token]]$OA$GO_BP } } # C5 subset GO CC if(enrichments2do$GO_CC){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_CC ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$GO_CC ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -580,15 +580,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$GO_CC <<- EnrichmentRes_GO_CC - par_tmp[[session_key]]$OA$GO_CC <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$GO_CC <<- EnrichmentRes_GO_CC + par_tmp[[session$token]]$OA$GO_CC <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_CC <- res_tmp[[session_key]]$OA$GO_CC + EnrichmentRes_GO_CC <- res_tmp[[session$token]]$OA$GO_CC } } # C5 subset GO MF if(enrichments2do$GO_MF){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$GO_MF ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$GO_MF ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -601,15 +601,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$GO_MF <<- EnrichmentRes_GO_MF - par_tmp[[session_key]]$OA$GO_MF <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$GO_MF <<- EnrichmentRes_GO_MF + par_tmp[[session$token]]$OA$GO_MF <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_MF <- res_tmp[[session_key]]$OA$GO_MF + EnrichmentRes_GO_MF <- res_tmp[[session$token]]$OA$GO_MF } } # C5 subset HPO if(enrichments2do$HPO){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$HPO ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$HPO ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -622,15 +622,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$HPO <<- EnrichmentRes_HPO - par_tmp[[session_key]]$OA$HPO <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$HPO <<- EnrichmentRes_HPO + par_tmp[[session$token]]$OA$HPO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_HPO <- res_tmp[[session_key]]$OA$HPO + EnrichmentRes_HPO <- res_tmp[[session$token]]$OA$HPO } } # C7 subset IMMUNESIGDB if(enrichments2do$IMMUNESIGDB){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$IMMUNESIGDB ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$IMMUNESIGDB ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -643,15 +643,15 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB - par_tmp[[session_key]]$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB + par_tmp[[session$token]]$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_IMMUNESIGDB <- res_tmp[[session_key]]$OA$IMMUNESIGDB + EnrichmentRes_IMMUNESIGDB <- res_tmp[[session$token]]$OA$IMMUNESIGDB } } # C7 subset VAX if(enrichments2do$VAX){ - if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session_key]]$OA$VAX ))){ + if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp[[session$token]]$OA$VAX ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -664,10 +664,10 @@ over_representation_analysis <- function( universe = universeSelected_tranlsated, TERM2GENE = genesets4ea ) - res_tmp[[session_key]]$OA$VAX <<- EnrichmentRes_VAX - par_tmp[[session_key]]$OA$VAX <<- list("Universe"=input$UniverseOfGene) + res_tmp[[session$token]]$OA$VAX <<- EnrichmentRes_VAX + par_tmp[[session$token]]$OA$VAX <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_VAX <- res_tmp[[session_key]]$OA$VAX + EnrichmentRes_VAX <- res_tmp[[session$token]]$OA$VAX } } diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R index bc91fa91..c57e2c35 100644 --- a/program/shinyApp/R/enrichment_analysis/server.R +++ b/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, diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R index c13816ce..2f43a592 100644 --- a/program/shinyApp/R/heatmap/server.R +++ b/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,8 +573,8 @@ 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)) @@ -583,7 +582,7 @@ heatmap_server <- function(id, data, params, updates){ 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){ diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R index 71a2a68c..97365ebc 100644 --- a/program/shinyApp/R/pca/server.R +++ b/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, diff --git a/program/shinyApp/R/pca/util.R b/program/shinyApp/R/pca/util.R index 23135161..8fa4719d 100644 --- a/program/shinyApp/R/pca/util.R +++ b/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, diff --git a/program/shinyApp/R/sample_correlation/server.R b/program/shinyApp/R/sample_correlation/server.R index 4212398f..b0d7e616 100644 --- a/program/shinyApp/R/sample_correlation/server.R +++ b/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" ) diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index 1622c0a9..c9364996 100644 --- a/program/shinyApp/R/significance_analysis/server.R +++ b/program/shinyApp/R/significance_analysis/server.R @@ -181,8 +181,8 @@ significance_analysis_server <- function(id, data, params, updates){ ) # refresh the UI/data if needed observeEvent(input$refreshUI, { - data <- update_data(data, session_key) - params <- update_params(params, session_key) + data <- update_data(session$token) + params <- update_params(session$token) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) }) @@ -201,7 +201,7 @@ significance_analysis_server <- function(id, data, params, updates){ } print("Start the Significance Analysis") # update the data if needed - data <- update_data(data, session_key) + data <- update_data(session$token) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) # delete old panels @@ -229,10 +229,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[[session_key]]$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[[session_key]]$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( @@ -244,9 +244,9 @@ significance_analysis_server <- function(id, data, params, updates){ ), pAdjustMethod = PADJUST_METHOD[[input$test_correction]] ) - # fill in res_tmp[[session_key]], par_tmp[[session_key]] - res_tmp[[session_key]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]] - par_tmp[[session_key]]$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]] ) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 913b4427..9567073f 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -811,10 +811,10 @@ significance_analysis <- function( # skip if already there if(identical( list(test_method = method, test_correction = correction), - par_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] + par_tmp[[session$token]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] )){ print("Results exists, skipping calculations.") - sig_results[[names(contrasts)[comp_name]]] <- res_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] + sig_results[[names(contrasts)[comp_name]]] <- res_tmp[[session$token]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] comp_name <- comp_name + 1 next } @@ -850,9 +850,9 @@ significance_analysis <- function( sig_results[[names(contrasts)[comp_name]]] <- res - # fill res_tmp[[session_key]], par_tmp[[session_key]] - res_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- res - par_tmp[[session_key]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- list( + # fill res_tmp[[session$token]], par_tmp[[session$token]] + res_tmp[[session$token]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- res + par_tmp[[session$token]]$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- list( test_method = method, test_correction = correction ) @@ -925,9 +925,9 @@ getLFC <- function(means){ ) return (df$LFC) } - if(par_tmp[[session_key]]$PreProcessing_Procedure == "log10"){ + if(par_tmp[[session$token]]$PreProcessing_Procedure == "log10"){ lfc_per_gene_log(means, log_base = 10) - }else if(par_tmp[[session_key]]$PreProcessing_Procedure == "ln"){ + }else if(par_tmp[[session$token]]$PreProcessing_Procedure == "ln"){ lfc_per_gene_log(means, log_base = exp(1)) }else{ lfc_per_gene(means) diff --git a/program/shinyApp/R/single_gene_visualisation/server.R b/program/shinyApp/R/single_gene_visualisation/server.R index 64d43d5e..40d0b418 100644 --- a/program/shinyApp/R/single_gene_visualisation/server.R +++ b/program/shinyApp/R/single_gene_visualisation/server.R @@ -16,8 +16,8 @@ single_gene_visualisation_server <- function(id, data, params, updates){ # Refresh UI /Data observeEvent(input$refreshUI,{ print("Refresh UI Single Gene") - data <- update_data(data, session_key) - params <- update_params(params, session_key) + data <- update_data(session$token) + params <- update_params(session$token) single_Gene_vis$current_updates <- updates() ## Ui section ---- @@ -129,7 +129,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ print(input$Select_Gene) if(single_Gene_vis$calculate == 1){ # update the data if needed - data <- update_data(data, session_key) + data <- update_data(session$token) single_Gene_vis$current_updates <- updates() # set the counter to 0 to prevent any further plotting single_Gene_vis$calculate <- 0 @@ -254,11 +254,11 @@ single_gene_visualisation_server <- function(id, data, params, updates){ } # Where to save the plot (needed currently to be global, to be able to be saved) - res_tmp[[session_key]][["SingleEntVis"]] <<- P_boxplots + res_tmp[[session$token]][["SingleEntVis"]] <<- P_boxplots #SingleEnt_P_boxplots <- P_boxplots - # DO not know if necassary to track in par_tmp[[session_key]] (if not global var needed) - par_tmp[[session_key]][["SingleEntVis"]] <<- list( + # DO not know if necassary to track in par_tmp[[session$token]] (if not global var needed) + par_tmp[[session$token]][["SingleEntVis"]] <<- list( SingleEnt_customTitle_boxplot = SingleEnt_customTitle_boxplot, SingleEnt_Select_Gene = input$Select_Gene, SingleEnt_type_of_data_gene = input$type_of_data_gene, @@ -306,7 +306,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ output$SavePlot_singleGene <- downloadHandler( filename = function() { paste( - par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session$token]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), input$file_ext_singleGene,sep="" @@ -316,7 +316,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ content = function(file){ ggsave( file = file, - plot = res_tmp[[session_key]]$SingleEntVis, + plot = res_tmp[[session$token]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) @@ -325,14 +325,14 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session$token]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), input$file_ext_singleGene,sep="") ) ggsave( filename = tmp_filename, - plot = res_tmp[[session_key]]$SingleEntVis, + plot = res_tmp[[session$token]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) fun_LogIt("## Single Entitie") @@ -360,7 +360,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp[[session_key]]$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session$token]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), ".png", @@ -368,27 +368,27 @@ single_gene_visualisation_server <- function(id, data, params, updates){ ) ggsave( filename = tmp_filename, - plot = res_tmp[[session_key]]$SingleEntVis, + plot = res_tmp[[session$token]]$SingleEntVis, device = "png" ) fun_LogIt(message = "## Single Entitie") fun_LogIt(message = paste0( "**Single Entitie** - The following single entitie was plotted: ", - par_tmp[[session_key]]$SingleEntVis$SingleEnt_Select_Gene)) + par_tmp[[session$token]]$SingleEntVis$SingleEnt_Select_Gene)) fun_LogIt(message = paste0( "**Single Entitie** - Values shown are: ", - par_tmp[[session_key]]$SingleEntVis$SingleEnt_type_of_data_gene, " data input")) + par_tmp[[session$token]]$SingleEntVis$SingleEnt_type_of_data_gene, " data input")) fun_LogIt(message = paste0( "**Single Entitie** - Values are grouped for all levels within: ", - par_tmp[[session_key]]$SingleEntVis$SingleEnt_accross_condition, + par_tmp[[session$token]]$SingleEntVis$SingleEnt_accross_condition, " (", - paste0(levels(par_tmp[[session_key]]$SingleEntVis$SingleEnt_GeneData_anno),collapse = ";") + paste0(levels(par_tmp[[session$token]]$SingleEntVis$SingleEnt_GeneData_anno),collapse = ";") ,")")) fun_LogIt(message = paste0( "**Single Entitie** - Test for differences: ", - par_tmp[[session_key]]$SingleEntVis$SingleEnt_testMethod)) + par_tmp[[session$token]]$SingleEntVis$SingleEnt_testMethod)) - if(length(levels(par_tmp[[session_key]]$SingleEntVis$SingleEnt_GeneData_anno))>2){ + if(length(levels(par_tmp[[session$token]]$SingleEntVis$SingleEnt_GeneData_anno))>2){ fun_LogIt( message = paste0("**Single Entitie** - ANOVA performed, reference group is the overall mean") ) diff --git a/program/shinyApp/R/util.R b/program/shinyApp/R/util.R index 58d390dd..62df1bcf 100644 --- a/program/shinyApp/R/util.R +++ b/program/shinyApp/R/util.R @@ -1,10 +1,10 @@ ### general utility functions will be defined here -update_data <- function(data, session_key){ +update_data <- function(session_id){ # for stability reasons, data is ALWAYS pulled here print("Updating data...") - data <- res_tmp[[session_key]] + data <- res_tmp[[session_id]] return(data) } @@ -27,11 +27,11 @@ select_data <- function(data, selected_samples, sample_type){ } -update_params <- function(params, session_key){ +update_params <- function(session_id){ # update parameter if updates is larger than current_updates # could force to always update print("Updating parameters...") - params <- par_tmp[[session_key]] + params <- par_tmp[[session_id]] return(params) } diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index 5e5652d8..ef5ae465 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -4,9 +4,11 @@ server <- function(input,output,session){ global_Vars <<- reactiveValues() # OUTDATED? - # session sepcific key - session_key <- session$token - + # fill session_if textOutput with current session$token + output$session_id <- renderText({ + paste0("Current session: ", session$token) + }) + # getCurrentVersion(updateDESCRIPTION=T) # Where to Place this ? So it does not always get 'updated'? # Can we add this somehow as necassary to every new release? @@ -75,9 +77,15 @@ server <- function(input,output,session){ res_tmp <<- list() par_tmp <<- list() } - # create an empty list in res/par_tmp[[session_key]] - res_tmp[[session_key]] <<- list() - par_tmp[[session_key]] <<- list() + # create an empty list in res/par_tmp[[session$token]] + res_tmp[[session$token]] <<- list() + par_tmp[[session$token]] <<- list() + # On session end, remove the list from res/par_tmp + session$onSessionEnded(function() { + res_tmp[[session$token]] <<- NULL + par_tmp[[session$token]] <<- NULL + }) + browser() # Init update Object ---- # updating is a reative value that counts up whenever data is updated # this is used to trigger the update of the servers @@ -194,7 +202,7 @@ server <- function(input,output,session){ content = function(file){ # TODO Q: What to save here? only original enough? saveRDS( - object = res_tmp[[session_key]]$data_original, + object = res_tmp[[session$token]]$data_original, file = file ) } @@ -352,11 +360,11 @@ server <- function(input,output,session){ ## Do Upload ---- observeEvent(input$refresh1,{ - par_tmp[[session_key]]['omic_type'] <<- input$omicType + par_tmp[[session$token]]['omic_type'] <<- input$omicType fun_LogIt(message = "## DataInput {.tabset .tabset-fade}") fun_LogIt(message = "### Info") fun_LogIt( - message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp[[session_key]]['omic_type']) + message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp[[session$token]]['omic_type']) ) if(!(isTruthy(input$data_preDone) | FLAG_TEST_DATA_SELECTED() | @@ -368,8 +376,8 @@ server <- function(input,output,session){ output$debug <- renderText({"The Test Data Set was used"}) }else{ show_toast( - title = paste0(par_tmp[[session_key]]['omic_type'],"Data Upload"), - text = paste0(par_tmp[[session_key]]['omic_type'],"-data upload was successful"), + title = paste0(par_tmp[[session$token]]['omic_type'],"Data Upload"), + text = paste0(par_tmp[[session$token]]['omic_type'],"-data upload was successful"), position = "top", timer = 1500, timerProgressBar = T @@ -498,32 +506,32 @@ server <- function(input,output,session){ #TODO make the copy and tab show process dependent if we get here a results object or 'simple' rds } # TODO SumExp only needed hence more restructuring needed - res_tmp[[session_key]][['data_original']] <<- data_input[[paste0(input$omicType,"_SumExp")]] + res_tmp[[session$token]][['data_original']] <<- data_input[[paste0(input$omicType,"_SumExp")]] # Make a copy, to leave original data untouched - res_tmp[[session_key]][['data']] <<- res_tmp[[session_key]]$data_original + res_tmp[[session$token]][['data']] <<- res_tmp[[session$token]]$data_original # Count up updating updating$count <- updating$count + 1 print(paste0( - "(before) No. anno options sample_table: ",ncol(res_tmp[[session_key]]$data_original) + "(before) No. anno options sample_table: ",ncol(res_tmp[[session$token]]$data_original) )) - colData(res_tmp[[session_key]]$data) <- - DataFrame(as.data.frame(colData(res_tmp[[session_key]]$data)) %>% + colData(res_tmp[[session$token]]$data) <- + DataFrame(as.data.frame(colData(res_tmp[[session$token]]$data)) %>% purrr::keep(~length(unique(.x)) != 1)) print(paste0( - "(after) No. anno options sample_table: ",ncol(res_tmp[[session_key]]$data) + "(after) No. anno options sample_table: ",ncol(res_tmp[[session$token]]$data) )) print(paste0( - "(before) No. anno options annotation_rows: ",ncol(res_tmp[[session_key]]$data_original) + "(before) No. anno options annotation_rows: ",ncol(res_tmp[[session$token]]$data_original) )) - rowData(res_tmp[[session_key]]$data) <- - DataFrame(as.data.frame(rowData(res_tmp[[session_key]]$data)) %>% + rowData(res_tmp[[session$token]]$data) <- + DataFrame(as.data.frame(rowData(res_tmp[[session$token]]$data)) %>% purrr::keep(~length(unique(.x)) != 1)) print(paste0( - "(after) No. anno options annotation_rows: ",ncol(res_tmp[[session_key]]$data) + "(after) No. anno options annotation_rows: ",ncol(res_tmp[[session$token]]$data) )) fun_LogIt( @@ -532,13 +540,13 @@ server <- function(input,output,session){ ) fun_LogIt( message = paste0("**DataInput** - The raw data dimensions are:", - paste0(dim(res_tmp[[session_key]]$data_original),collapse = ", ")) + paste0(dim(res_tmp[[session$token]]$data_original),collapse = ", ")) ) fun_LogIt(message = "### Publication Snippet") fun_LogIt(message = snippet_dataInput( - data_type = par_tmp[[session_key]]$omic_type, - data_dimension = paste0(dim(res_tmp[[session_key]]$data_original),collapse = ", ") + data_type = par_tmp[[session$token]]$omic_type, + data_dimension = paste0(dim(res_tmp[[session$token]]$data_original),collapse = ", ") )) fun_LogIt(message = "
") return("DataUploadSuccesful") @@ -550,14 +558,14 @@ server <- function(input,output,session){ ## Ui Section ---- observe({ req(data_input_shiny()) - isTruthy(res_tmp[[session_key]]$data) + isTruthy(res_tmp[[session$token]]$data) # Row output$providedRowAnnotationTypes_ui=renderUI({ req(data_input_shiny()) shinyWidgets::virtualSelectInput( inputId = "providedRowAnnotationTypes", label = "Which annotation type do you want to select on?", - choices = c(colnames(rowData(res_tmp[[session_key]]$data_original))), + choices = c(colnames(rowData(res_tmp[[session$token]]$data_original))), multiple = F, search = T, showSelectedOptionsFirst = T @@ -568,7 +576,7 @@ server <- function(input,output,session){ req(data_input_shiny()) req(input$providedRowAnnotationTypes) if(is.numeric( - rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes]) + rowData(res_tmp[[session$token]]$data_original)[,input$providedRowAnnotationTypes]) ){ selectInput( inputId = "row_selection", @@ -581,7 +589,7 @@ server <- function(input,output,session){ shinyWidgets::virtualSelectInput( inputId = "row_selection", label = "Which entities to use? (Will be the union if multiple selected)", - choices = c("High Values+IQR","all",unique(unlist(strsplit(rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes],"\\|")))), + choices = c("High Values+IQR","all",unique(unlist(strsplit(rowData(res_tmp[[session$token]]$data_original)[,input$providedRowAnnotationTypes],"\\|")))), selected = "all", multiple = T, search = T, @@ -612,8 +620,8 @@ server <- function(input,output,session){ selectInput( inputId = "providedSampleAnnotationTypes", label = "Which annotation type do you want to select on?", - choices = c(colnames(colData(res_tmp[[session_key]]$data_original))), - selected = c(colnames(colData(res_tmp[[session_key]]$data_original)))[1], + choices = c(colnames(colData(res_tmp[[session$token]]$data_original))), + selected = c(colnames(colData(res_tmp[[session$token]]$data_original)))[1], multiple = F ) }) @@ -624,7 +632,7 @@ server <- function(input,output,session){ label = "Which entities to use? (Will be the union if multiple selected)", choices = c( "all", - unique(colData(res_tmp[[session_key]]$data_original)[,input$providedSampleAnnotationTypes]) + unique(colData(res_tmp[[session$token]]$data_original)[,input$providedSampleAnnotationTypes]) ), selected = "all", multiple = T @@ -677,17 +685,17 @@ server <- function(input,output,session){ ## Do Selection ---- selectedData <- reactive({ shiny::req(input$row_selection, input$sample_selection) - par_tmp[[session_key]][["row_selection"]] <<- input$row_selection + par_tmp[[session$token]][["row_selection"]] <<- input$row_selection print("Alright do Row selection") selected <- c() if(any(input$row_selection == "all")){ - selected <- rownames(rowData(res_tmp[[session_key]]$data_original)) + selected <- rownames(rowData(res_tmp[[session$token]]$data_original)) }else if(!(length(input$row_selection) == 1 & any(input$row_selection == "High Values+IQR"))){ selected <- unique( c(selected, - rownames(rowData(res_tmp[[session_key]]$data_original))[ - which(rowData(res_tmp[[session_key]]$data_original)[,input$providedRowAnnotationTypes]%in%input$row_selection) + rownames(rowData(res_tmp[[session$token]]$data_original))[ + which(rowData(res_tmp[[session$token]]$data_original)[,input$providedRowAnnotationTypes]%in%input$row_selection) ] ) ) @@ -695,17 +703,17 @@ server <- function(input,output,session){ if(any(input$row_selection == "High Values+IQR")){ if(length(input$row_selection) == 1){ toKeep <- filter_rna( - rna = assay(res_tmp[[session_key]]$data_original), + rna = assay(res_tmp[[session$token]]$data_original), prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session$token]]$data_original)[toKeep,] selected <- rownames(filteredIQR_Expr) }else{ toKeep <- filter_rna( - rna = assay(res_tmp[[session_key]]$data_original)[selected,], + rna = assay(res_tmp[[session$token]]$data_original)[selected,], prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp[[session_key]]$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session$token]]$data_original)[toKeep,] selected <- intersect( selected, rownames(filteredIQR_Expr) @@ -717,20 +725,20 @@ server <- function(input,output,session){ # Column Selection samples_selected <- c() if(any(input$sample_selection == "all")){ - samples_selected <- colnames(assay(res_tmp[[session_key]]$data_original)) + samples_selected <- colnames(assay(res_tmp[[session$token]]$data_original)) }else{ samples_selected <- c( samples_selected, - rownames(colData(res_tmp[[session_key]]$data_original))[which( - colData(res_tmp[[session_key]]$data_original)[,input$providedSampleAnnotationTypes] %in% input$sample_selection + rownames(colData(res_tmp[[session$token]]$data_original))[which( + colData(res_tmp[[session$token]]$data_original)[,input$providedSampleAnnotationTypes] %in% input$sample_selection )] ) } # Data set selection print("Alright do Column selection") - res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data_original[selected,samples_selected] - tmp_data_selected <<- res_tmp[[session_key]]$data_original[selected,samples_selected] + res_tmp[[session$token]]$data <<- res_tmp[[session$token]]$data_original[selected,samples_selected] + tmp_data_selected <<- res_tmp[[session$token]]$data_original[selected,samples_selected] return("Selection Success") }) @@ -811,42 +819,42 @@ server <- function(input,output,session){ print("Do Preprocessing") print(selectedData()) addWarning <- "" - par_tmp[[session_key]]['PreProcessing_Procedure'] <<- input$PreProcessing_Procedure + par_tmp[[session$token]]['PreProcessing_Procedure'] <<- input$PreProcessing_Procedure processedData_all <- tmp_data_selected # as general remove all genes which are constant over all rows print("As general remove all entities which are constant over all samples") - res_tmp[[session_key]]$data <<- tmp_data_selected[rownames(tmp_data_selected[which(apply(assay(tmp_data_selected),1,sd) != 0),]),] + res_tmp[[session$token]]$data <<- tmp_data_selected[rownames(tmp_data_selected[which(apply(assay(tmp_data_selected),1,sd) != 0),]),] - print(dim(res_tmp[[session_key]]$data)) + print(dim(res_tmp[[session$token]]$data)) # explicitly set rownames to avoid any errors. - # new object Created for res_tmp[[session_key]] - res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data[rownames(res_tmp[[session_key]]$data),] + # new object Created for res_tmp[[session$token]] + res_tmp[[session$token]]$data <<- res_tmp[[session$token]]$data[rownames(res_tmp[[session$token]]$data),] if(input$PreProcessing_Procedure != "none"){ if(input$PreProcessing_Procedure == "filterOnly"){ - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ + if(par_tmp[[session$token]]$omic_type == "Transcriptomics"){ print("Also remove anything of rowCount <=10") print(dim(tmp_data_selected)) - res_tmp[[session_key]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] + res_tmp[[session$token]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] } - if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ + if(par_tmp[[session$token]]$omic_type == "Metabolomics"){ print("Remove anything which has a row median of 0") print(dim(tmp_data_selected)) - res_tmp[[session_key]]$data <<- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),] + res_tmp[[session$token]]$data <<- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),] } addWarning <- "Only Filtering of low abundant is done only if Transcriptomics or Metabolomics was chosen\n" }else{ - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ + if(par_tmp[[session$token]]$omic_type == "Transcriptomics"){ print("Also remove anything of rowCount <=10") print(dim(tmp_data_selected)) - res_tmp[[session_key]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] + res_tmp[[session$token]]$data <<- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),] } - if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ + if(par_tmp[[session$token]]$omic_type == "Metabolomics"){ print("Remove anything which has a row median of 0") print(dim(tmp_data_selected)) @@ -854,27 +862,27 @@ server <- function(input,output,session){ } } - print(dim(res_tmp[[session_key]]$data)) + print(dim(res_tmp[[session$token]]$data)) print(paste0("Do chosen Preprocessing:",input$PreProcessing_Procedure)) if(input$PreProcessing_Procedure == "simpleCenterScaling"){ processedData <- as.data.frame(t( scale( - x = as.data.frame(t(as.data.frame(assay(res_tmp[[session_key]]$data)))), + x = as.data.frame(t(as.data.frame(assay(res_tmp[[session$token]]$data)))), scale = T, center = T ) ) ) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "vst_DESeq"){ - par_tmp[[session_key]]["DESeq_advanced"] <<- FALSE - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ + par_tmp[[session$token]]["DESeq_advanced"] <<- FALSE + if(par_tmp[[session$token]]$omic_type == "Transcriptomics"){ design_formula <- paste("~", input$DESeq_formula_main) # only do this locally - colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main] <- as.factor( - colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main] + colData(res_tmp[[session$token]]$data)[,input$DESeq_formula_main] <- as.factor( + colData(res_tmp[[session$token]]$data)[,input$DESeq_formula_main] ) if(length(input$DESeq_formula_sub) > 0){ design_formula <- paste( @@ -883,63 +891,63 @@ server <- function(input,output,session){ ) # turn each factor into a factor for(i in input$DESeq_formula_sub){ - colData(res_tmp[[session_key]]$data)[,i] <- as.factor( - colData(res_tmp[[session_key]]$data)[,i] + colData(res_tmp[[session$token]]$data)[,i] <- as.factor( + colData(res_tmp[[session$token]]$data)[,i] ) } - par_tmp[[session_key]][["DESeq_factors"]] <<- c( + par_tmp[[session$token]][["DESeq_factors"]] <<- c( input$DESeq_formula_main,input$DESeq_formula_sub ) } else{ - par_tmp[[session_key]][["DESeq_factors"]] <<- c(input$DESeq_formula_main) + par_tmp[[session$token]][["DESeq_factors"]] <<- c(input$DESeq_formula_main) } # if advanced formula is used, overwrite the other formula if(input$DESeq_show_advanced){ if(startsWith(input$DESeq_formula_advanced, "~")){ print("Advanced formula used") design_formula <- input$DESeq_formula_advanced - par_tmp[[session_key]]["DESeq_advanced"] <<- TRUE + par_tmp[[session$token]]["DESeq_advanced"] <<- TRUE } } print(design_formula) - par_tmp[[session_key]]["DESeq_formula"] <<- design_formula + par_tmp[[session$token]]["DESeq_formula"] <<- design_formula # on purpose local - print(colData(res_tmp[[session_key]]$data)[,input$DESeq_formula_main]) + print(colData(res_tmp[[session$token]]$data)[,input$DESeq_formula_main]) dds <- DESeq2::DESeqDataSetFromMatrix( - countData = assay(res_tmp[[session_key]]$data), - colData = colData(res_tmp[[session_key]]$data), + countData = assay(res_tmp[[session$token]]$data), + colData = colData(res_tmp[[session$token]]$data), design = as.formula(design_formula) ) de_seq_result <- DESeq2::DESeq(dds) - res_tmp[[session_key]]$DESeq_obj <<- de_seq_result + res_tmp[[session$token]]$DESeq_obj <<- de_seq_result dds_vst <- vst( object = de_seq_result, blind = TRUE ) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(assay(dds_vst)) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(assay(dds_vst)) }else{ addWarning <- "DESeq makes only sense for transcriptomics data - data treated as if 'none' was selected!" } } if(input$PreProcessing_Procedure == "Scaling_0_1"){ processedData <- as.data.frame(t( - apply(assay(res_tmp[[session_key]]$data),1,function(x){ + apply(assay(res_tmp[[session$token]]$data),1,function(x){ (x - min(x))/(max(x) - min(x)) }) )) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "ln"){ processedData <- as.data.frame(log( - as.data.frame(assay(res_tmp[[session_key]]$data)) + as.data.frame(assay(res_tmp[[session$token]]$data)) )) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "log10"){ - processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) + processedData <- as.data.frame(assay(res_tmp[[session$token]]$data)) if(any(processedData<0)){ addWarning <- "Negative entries, cannot take log10!!" } @@ -951,10 +959,10 @@ server <- function(input,output,session){ processedData <- as.data.frame(log10( processedData + 1) ) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(processedData) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(processedData) } if(input$PreProcessing_Procedure == "pareto_scaling"){ - processedData <- as.data.frame(assay(res_tmp[[session_key]]$data)) + processedData <- as.data.frame(assay(res_tmp[[session$token]]$data)) centered <- as.data.frame(t( apply(processedData, 1, function(x){x - mean(x)}) )) @@ -962,24 +970,24 @@ server <- function(input,output,session){ apply(centered, 1, function(x){x/sqrt(sd(x))}) )) - assay(res_tmp[[session_key]]$data) <<- as.data.frame(pareto.matrix) + assay(res_tmp[[session$token]]$data) <<- as.data.frame(pareto.matrix) } } - if(any(is.na(assay(res_tmp[[session_key]]$data)))){ + if(any(is.na(assay(res_tmp[[session$token]]$data)))){ print("This might be problem due to mismatched Annotation Data?!") - nrow_before <- nrow(assay(res_tmp[[session_key]]$data)) + nrow_before <- nrow(assay(res_tmp[[session$token]]$data)) nrow_after <- nrow( - res_tmp[[session_key]]$data[complete.cases(assay(res_tmp[[session_key]]$data)),] + res_tmp[[session$token]]$data[complete.cases(assay(res_tmp[[session$token]]$data)),] ) addWarning <- paste0("There were NA's after pre-processing, any row containg such was completly removed! (before/after): ",nrow_before,"/",nrow_after,"") if(!(nrow_after > 0)){ addWarning <- paste0(addWarning, "
There is nothing left, choose different pre-processing other-wise App will crash!") } - res_tmp[[session_key]]$data <<- res_tmp[[session_key]]$data[complete.cases(assay(res_tmp[[session_key]]$data)),] + res_tmp[[session$token]]$data <<- res_tmp[[session$token]]$data[complete.cases(assay(res_tmp[[session$token]]$data)),] } - print(colnames(res_tmp[[session_key]]$data)) + print(colnames(res_tmp[[session$token]]$data)) showTab(inputId = "tabsetPanel1", target = "Sample Correlation") showTab(inputId = "tabsetPanel1", target = "Significance Analysis") @@ -997,11 +1005,11 @@ server <- function(input,output,session){ shinyjs::click("single_gene_visualisation-refreshUI",asis = T) paste0(addWarning, "The data has the dimensions of: ", - paste0(dim(res_tmp[[session_key]]$data),collapse = ", "), + paste0(dim(res_tmp[[session$token]]$data),collapse = ", "), "
","Be aware that depending on omic-Type, basic pre-processing has been done anyway even when selecting none", "",ifelse(any(as.data.frame(assay(res_tmp[[session_key]]$data)) < 0),"Be aware that processed data has negative values, hence no log fold changes can be calculated","")) + "
",ifelse(any(as.data.frame(assay(res_tmp[[session$token]]$data)) < 0),"Be aware that processed data has negative values, hence no log fold changes can be calculated","")) }) @@ -1026,9 +1034,9 @@ server <- function(input,output,session){ ## Log preprocessing ---- observeEvent(input$Do_preprocessing,{ print(selectedData_processed()) - if(par_tmp[[session_key]]$omic_type == "Transcriptomics"){ + if(par_tmp[[session$token]]$omic_type == "Transcriptomics"){ tmp_logMessage <- "Remove anything which row Count <= 10" - }else if(par_tmp[[session_key]]$omic_type == "Metabolomics"){ + }else if(par_tmp[[session$token]]$omic_type == "Metabolomics"){ tmp_logMessage <- "Remove anything which has a row median of 0" }else{ tmp_logMessage <- "none" @@ -1046,20 +1054,20 @@ server <- function(input,output,session){ fun_LogIt( message = paste0( "**PreProcessing** - The resulting dimensions are: ", - paste0(dim(res_tmp[[session_key]]$data),collapse = ", ") + paste0(dim(res_tmp[[session$token]]$data),collapse = ", ") ) ) }) - output$debug <- renderText(dim(res_tmp[[session_key]]$data)) + output$debug <- renderText(dim(res_tmp[[session$token]]$data)) ## UP TILL HERE ## # Sample Correlation ---- # calling server without reactive it will be init upon start, with no update # of respective data inputs hence need of at least one reactive! sample_correlation_server( id = "sample_correlation", - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) #omic_type = reactive(input$omicType), # par_tmp$omic_type #row_select = reactive(input$row_selection) #par_tmp$row_selection ? # only for title? @@ -1068,30 +1076,30 @@ server <- function(input,output,session){ # significance analysis ---- significance_analysis_server( id = 'SignificanceAnalysis', - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) # PCA ---- pca_Server( id = "PCA", - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(input$row_selection), reactive(updating$count) ) # Heatmap ---- heatmap_server( id = 'Heatmap', - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) # Single Gene Visualisations ---- single_gene_visualisation_server( id = 'single_gene_visualisation', - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) @@ -1099,8 +1107,8 @@ server <- function(input,output,session){ # Enrichment Analysis ---- enrichment_analysis_Server( id = 'EnrichmentAnalysis', - data = res_tmp[[session_key]], - params = par_tmp[[session_key]], + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) } diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index 2405b4e2..9697173f 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -185,6 +185,7 @@ ui <- shiny::fluidPage( helpText("Metabolon Help", align = "center") %>% helper(type = "markdown", content = "Metabolon_help", size = "l", colour = "blue", style = "position: relative;top: -18px;left: 15px;; zoom: 200%;"), NULL ), + tabsetPanel( id = "tabsetPanel1", ################################################################################ @@ -241,6 +242,12 @@ ui <- shiny::fluidPage( bottom = 0, left = 10, fixed = TRUE,style = "background-color: #a9d96a;" ) ) + ), + # Pannel displaying the current session id + absolutePanel( + # text output needs to be defined in server + textOutput("session_id"), + bottom = 0, right = 10, fixed = TRUE ) ) From 96bb1891e773f80a35c9d84f4584cfa277f8fbbd Mon Sep 17 00:00:00 2001 From: Paul Jonas Jost <70631928+PaulJonasJost@users.noreply.github.com> Date: Wed, 24 Jan 2024 14:34:34 +0100 Subject: [PATCH 5/6] Update program/shinyApp/server.R Co-authored-by: Lea Seep <74967328+LeaSeep@users.noreply.github.com> --- program/shinyApp/server.R | 1 - 1 file changed, 1 deletion(-) diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index ef5ae465..ffa71dc0 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -85,7 +85,6 @@ server <- function(input,output,session){ res_tmp[[session$token]] <<- NULL par_tmp[[session$token]] <<- NULL }) - browser() # Init update Object ---- # updating is a reative value that counts up whenever data is updated # this is used to trigger the update of the servers From ce4d81eec07ab1af13b9ed6fcc5f30a0bac28f6e Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Wed, 24 Jan 2024 14:52:30 +0100 Subject: [PATCH 6/6] Merge conflicts --- program/shinyApp/R/enrichment_analysis/server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R index b8c4ab49..0251af57 100644 --- a/program/shinyApp/R/enrichment_analysis/server.R +++ b/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({