diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R index 276319da..d40d112a 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$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$EA[[comp_type]][[contrast]]$KEGG <<- EnrichmentRes_Kegg - par_tmp$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$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$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 = PADJUST_METHOD[[adjustMethod]] ) - res_tmp$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$Hallmarks <<- EnrichmentRes_Hallmarks - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C1 <<- EnrichmentRes_C1 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C2 <<- EnrichmentRes_C2 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C3 <<- EnrichmentRes_C3 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C4 <<- EnrichmentRes_C4 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C5 <<- EnrichmentRes_C5 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C6 <<- EnrichmentRes_C6 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C7 <<- EnrichmentRes_C7 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$C8 <<- EnrichmentRes_C8 - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$CGP <<- EnrichmentRes_CGP - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$CP <<- EnrichmentRes_CP - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$BIOCARTA <<- EnrichmentRes_BIOCARTA - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$PID <<- EnrichmentRes_PID - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$REACTOME <<- EnrichmentRes_REACTOME - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$MIRDB <<- EnrichmentRes_MIRDB - par_tmp$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$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$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$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$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$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$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$EA[[comp_type]][[contrast]]$GTRD <<- EnrichmentRes_GTRD - par_tmp$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$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$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$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$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$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$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$EA[[comp_type]][[contrast]]$CGN <<- EnrichmentRes_CGN - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$CM <<- EnrichmentRes_CM - par_tmp$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$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$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$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$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$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$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$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$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$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$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$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$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$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$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$EA[[comp_type]][[contrast]]$HPO <<- EnrichmentRes_HPO - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB - par_tmp$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$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$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$EA[[comp_type]][[contrast]]$VAX <<- EnrichmentRes_VAX - par_tmp$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$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 3086941d..733d50f6 100644 --- a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R @@ -69,7 +69,7 @@ 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$token]]$OA$KEGG ))){ EnrichmentRes_KEGG <- clusterProfiler::enrichKEGG( gene = geneSetChoice, organism = input$OrganismChoice, @@ -77,15 +77,15 @@ over_representation_analysis <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], universe = universeSelected_tranlsated ) - res_tmp$OA$KEGG <<- EnrichmentRes_KEGG - par_tmp$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$OA$KEGG + EnrichmentRes_KEGG <- res_tmp[[session$token]]$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$token]]$OA$GO ))){ EnrichmentRes_GO <- clusterProfiler::enrichGO( gene = geneSetChoice, ont = "ALL", @@ -93,15 +93,15 @@ over_representation_analysis <- function( pAdjustMethod = PADJUST_METHOD[[adjustMethod]], 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$token]]$OA$GO <<- EnrichmentRes_GO + par_tmp[[session$token]]$OA$GO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO <- res_tmp$OA$GO + EnrichmentRes_GO <- res_tmp[[session$token]]$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$token]]$OA$REACTOME ))){ EnrichmentRes_REACTOME <- ReactomePA::enrichPathway( gene = geneSetChoice, pvalueCutoff = 0.05, @@ -110,15 +110,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$token]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session$token]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp$OA$REACTOME + EnrichmentRes_REACTOME <- res_tmp[[session$token]]$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$token]]$OA$Hallmarks ))){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "H", @@ -130,15 +130,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$token]]$OA$Hallmarks <<- EnrichmentRes_Hallmarks + par_tmp[[session$token]]$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_Hallmarks <- res_tmp$OA$Hallmarks + EnrichmentRes_Hallmarks <- res_tmp[[session$token]]$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$token]]$OA$C1 ))){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C1", @@ -150,15 +150,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$token]]$OA$C1 <<- EnrichmentRes_C1 + par_tmp[[session$token]]$OA$C1 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C1 <- res_tmp$OA$C1 + EnrichmentRes_C1 <- res_tmp[[session$token]]$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$token]]$OA$C2 ))){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -170,15 +170,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$token]]$OA$C2 <<- EnrichmentRes_C2 + par_tmp[[session$token]]$OA$C2 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C2 <- res_tmp$OA$C2 + EnrichmentRes_C2 <- res_tmp[[session$token]]$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$token]]$OA$C3 ))){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C3", @@ -190,15 +190,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$token]]$OA$C3 <<- EnrichmentRes_C3 + par_tmp[[session$token]]$OA$C3 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C3 <- res_tmp$OA$C3 + EnrichmentRes_C3 <- res_tmp[[session$token]]$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$token]]$OA$C4 ))){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -210,15 +210,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$token]]$OA$C4 <<- EnrichmentRes_C4 + par_tmp[[session$token]]$OA$C4 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C4 <- res_tmp$OA$C4 + EnrichmentRes_C4 <- res_tmp[[session$token]]$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$token]]$OA$C5 ))){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C5", @@ -230,15 +230,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$token]]$OA$C5 <<- EnrichmentRes_C5 + par_tmp[[session$token]]$OA$C5 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C5 <- res_tmp$OA$C5 + EnrichmentRes_C5 <- res_tmp[[session$token]]$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$token]]$OA$C6 ))){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C6", @@ -250,15 +250,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$token]]$OA$C6 <<- EnrichmentRes_C6 + par_tmp[[session$token]]$OA$C6 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C6 <- res_tmp$OA$C6 + EnrichmentRes_C6 <- res_tmp[[session$token]]$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$token]]$OA$C7 ))){ C7set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -271,15 +271,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$token]]$OA$C7 <<- EnrichmentRes_C7 + par_tmp[[session$token]]$OA$C7 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C7 <- res_tmp$OA$C7 + EnrichmentRes_C7 <- res_tmp[[session$token]]$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$token]]$OA$C8 ))){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C8", @@ -291,15 +291,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$token]]$OA$C8 <<- EnrichmentRes_C8 + par_tmp[[session$token]]$OA$C8 <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_C8 <- res_tmp$OA$C8 + EnrichmentRes_C8 <- res_tmp[[session$token]]$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$token]]$OA$CGP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -312,15 +312,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$token]]$OA$CGP <<- EnrichmentRes_CGP + par_tmp[[session$token]]$OA$CGP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGP <- res_tmp$OA$CGP + EnrichmentRes_CGP <- res_tmp[[session$token]]$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$token]]$OA$CP ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C2", @@ -333,15 +333,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$token]]$OA$CP <<- EnrichmentRes_CP + par_tmp[[session$token]]$OA$CP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CP <- res_tmp$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$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", @@ -354,15 +354,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$token]]$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA + par_tmp[[session$token]]$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_BIOCARTA <- res_tmp$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$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", @@ -375,15 +375,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$token]]$OA$PID <<- EnrichmentRes_PID + par_tmp[[session$token]]$OA$PID <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_PID <- res_tmp$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$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", @@ -396,15 +396,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$token]]$OA$REACTOME <<- EnrichmentRes_REACTOME + par_tmp[[session$token]]$OA$REACTOME <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_REACTOME <- res_tmp$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$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", @@ -417,15 +417,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$token]]$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS + par_tmp[[session$token]]$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_WIKIPATHWAYS <- res_tmp$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$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", @@ -438,15 +438,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$token]]$OA$MIRDB <<- EnrichmentRes_MIRDB + par_tmp[[session$token]]$OA$MIRDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIRDB <- res_tmp$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$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", @@ -459,15 +459,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$token]]$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy + par_tmp[[session$token]]$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_MIR_Legacy <- res_tmp$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$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", @@ -480,15 +480,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$token]]$OA$GTRD <<- EnrichmentRes_GTRD + par_tmp[[session$token]]$OA$GTRD <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GTRD <- res_tmp$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$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", @@ -501,15 +501,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$token]]$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy + par_tmp[[session$token]]$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_TFT_Legacy <- res_tmp$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$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", @@ -522,15 +522,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$token]]$OA$CGN <<- EnrichmentRes_CGN + par_tmp[[session$token]]$OA$CGN <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CGN <- res_tmp$OA$CGN + EnrichmentRes_CGN <- res_tmp[[session$token]]$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$token]]$OA$CM ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C4", @@ -543,15 +543,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$token]]$OA$CM <<- EnrichmentRes_CM + par_tmp[[session$token]]$OA$CM <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_CM <- res_tmp$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$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", @@ -564,15 +564,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$token]]$OA$GO_BP <<- EnrichmentRes_GO_BP + par_tmp[[session$token]]$OA$GO_BP <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_BP <- res_tmp$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$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", @@ -585,15 +585,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$token]]$OA$GO_CC <<- EnrichmentRes_GO_CC + par_tmp[[session$token]]$OA$GO_CC <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_CC <- res_tmp$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$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", @@ -606,15 +606,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$token]]$OA$GO_MF <<- EnrichmentRes_GO_MF + par_tmp[[session$token]]$OA$GO_MF <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_GO_MF <- res_tmp$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$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", @@ -627,15 +627,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$token]]$OA$HPO <<- EnrichmentRes_HPO + par_tmp[[session$token]]$OA$HPO <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_HPO <- res_tmp$OA$HPO + EnrichmentRes_HPO <- res_tmp[[session$token]]$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$token]]$OA$IMMUNESIGDB ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -648,15 +648,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$token]]$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB + par_tmp[[session$token]]$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_IMMUNESIGDB <- res_tmp$OA$IMMUNESIGDB + EnrichmentRes_IMMUNESIGDB <- res_tmp[[session$token]]$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$token]]$OA$VAX ))){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), category = "C7", @@ -669,10 +669,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$token]]$OA$VAX <<- EnrichmentRes_VAX + par_tmp[[session$token]]$OA$VAX <<- list("Universe"=input$UniverseOfGene) }else{ - EnrichmentRes_VAX <- res_tmp$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 18a1a2ac..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({ @@ -804,9 +804,9 @@ enrichment_analysis_Server <- function(id, data, params, updates){ } ea_reactives$ea_info <- "**Enrichment Analysis Done!**" # res_temp Zuweisung - res_tmp["Enrichment"] <<- ea_reactives$enrichment_results + res_tmp[[session$token]]["Enrichment"] <<- ea_reactives$enrichment_results # par_temp Zuweisung - par_tmp["Enrichment"] <<- list( + par_tmp[[session$token]]["Enrichment"] <<- list( "ValueToAttach" = input$ValueToAttach, "GeneSet2Enrich" = input$GeneSet2Enrich, "Groups2Compare_ref_GSEA" = input$Groups2Compare_ref_GSEA, diff --git a/program/shinyApp/R/fun_getCodeSnippets.R b/program/shinyApp/R/fun_getCodeSnippets.R deleted file mode 100644 index 4c451d6b..00000000 --- a/program/shinyApp/R/fun_getCodeSnippets.R +++ /dev/null @@ -1,802 +0,0 @@ - -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 - # Selection ---- - if(any(par_tmp$row_selection == "all")){ - stringSelection <- 'selected <- rownames(rowData(res_tmp$data_original)) - ' - }else{ - if(!(length(par_tmp$row_selection) == 1 & any(par_tmp$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)] - ) - ) - ' - } - if(any(par_tmp$row_selection == "High Values+IQR") ){ - stringSelection <- 'toKeep <- filter_rna( - rna = assay(res_tmp$data_original), - prop = par_tmp$propensityChoiceUser - ) - filteredIQR_Expr <- assay(res_tmp$data_original)[toKeep,] - ' - if(length(par_tmp$row_selection) == 1){ - stringSelection <- paste0(stringSelection, - 'selected <- rownames(filteredIQR_Expr)') - }else{ - stringSelection <- paste0(stringSelection, - 'selected <- intersect( - selected, - rownames(filteredIQR_Expr) - )') - } - } - } - - if(par_tmp$col_selection == "all"){ - stringSelection <- paste0(stringSelection,"\n", - 'samples_selected <- colnames(assay(res_tmp$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 - )] - ) - ') - } - # Preprocessing ---- - - if(par_tmp$PreProcessing_Procedure != "none"){ - if(par_tmp$PreProcessing_Procedure == "filter_only"){ - if(par_tmp$omic_type == "Transcriptomics"){ - stringPreProcessing <- 'processedData <- tmp_data_selected[which(rowSums(assay(tmp_data_selected)) > 10),]' - } - if(par_tmp$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$omic_type == "Metabolomics"){ - prequel_stringPreProcessing <- 'res_tmp$data <- tmp_data_selected[which(apply(assay(tmp_data_selected),1,median)!=0),]' - } - } - - if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"){ - stringPreProcessing <- 'processedData <- as.data.frame(t( - scale( - x = as.data.frame(t(as.data.frame(assay(res_tmp$data)))), - scale = T, - center = T - ) - ) - ) - assay(res_tmp$data) <- as.data.frame(processedData) - ' - } - if(par_tmp$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) - ) - de_seq_result <- DESeq2::DESeq(dds) - res_tmp$DESeq_obj <- de_seq_result - dds_vst <- vst( - object = de_seq_result, - blind = TRUE - ) - assay(res_tmp$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){ - (x - min(x))/(max(x) - min(x)) - }) - )) - assay(res_tmp$data) <- as.data.frame(processedData) - ' - } - if(input$PreProcessing_Procedure == "ln"){ - stringPreProcessing <- 'processedData <- as.data.frame(log( - as.data.frame(assay(res_tmp$data)) - )) - assay(res_tmp$data) <- as.data.frame(processedData) - ' - } - if(input$PreProcessing_Procedure == "log10"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp$data)) - if(any(processedData==0)){ - processedData <- as.data.frame(log10( - processedData + 1) - ) - assay(res_tmp$data) <- as.data.frame(processedData) - }' - } - - if(input$PreProcessing_Procedure == "pareto_scaling"){ - stringPreProcessing <- 'processedData <- as.data.frame(assay(res_tmp$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$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$PCA$x,colData(res_tmp$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) - 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) -) -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))) -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] -) -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$entitie <- factor(LoadingsDF$entitie,levels = rownames(LoadingsDF)) -if(!is.null(par_tmp$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])) - ) -} - -df_loadings <- data.frame( - entity = row.names(res_tmp$PCA$rotation), - res_tmp$PCA$rotation[, 1:par_tmp$PCA$nPCAs_to_look_at] -) -df_loadings_filtered <- as.matrix(df_loadings[,-1]) >= abs(par_tmp$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)){ - 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])) - ) -}else{ - df_loadings$chosenAnno <- df_loadings$entity -} -' - - 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], - 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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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], - 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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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], - 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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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], - 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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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$PCA$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$PCA$y_axis_selection], - color=pcaData[,par_tmp$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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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$PCA$x_axis_selection], - y = pcaData[,par_tmp$PCA$y_axis_selection], - color=pcaData[,par_tmp$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")) + - coord_fixed()+ - theme_classic()+ - theme(aspect.ratio = 1)+ - ggtitle(par_tmp$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$PCA$EntitieAnno_Loadings),"",par_tmp$PCA$EntitieAnno_Loadings)) + - xlab(paste0("Loadings: ",par_tmp$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$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), - color="lightgrey" - ) + - geom_vline( - xintercept = c(-par_tmp$Volcano$lfc_threshold,par_tmp$Volcano$lfc_threshold), - color="lightgrey" - ) + - scale_color_manual(values=par_tmp$Volcano$colorScheme, name="")+ - scale_alpha_manual(values=par_tmp$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$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]) - colorTheme <- colorTheme[!is.na(names(colorTheme))] - mycolors[[par_tmp$Heatmap$anno_options]] <- colorTheme - } -} - - -# 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(!is.na(additionalInput_row_anno)){ - additionalInput_row_anno <- par_tmp$Heatmap$anno_options_heatmap - } - additionalInput_row_anno_factor <- par_tmp$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) - } -}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$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) - -# select TopK (if there is an ordering) -TopK2Show <- ifelse(any(par_tmp$Heatmap$row_selection_options=="TopK"),par_tmp$Heatmap$TopK,NA) - -if(any(par_tmp$Heatmap$row_selection_options=="all")){ - print("No entitie selection") - data2HandOver <- as.data.frame(assay(res_tmp$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$data, - type = par_tmp$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$data)[,par_tmp$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 - ) -comparison_samples_idx <- which( - colData(res_tmp$data)[,par_tmp$Heatmap$sample_annotation_types_cmp_heatmap]%in%par_tmp$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){ - 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$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] -} - - -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"), - # 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$data)[,par_tmp$Heatmap$anno_options,drop=F] -annotation_row <- rowData(res_tmp$data)[,par_tmp$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) - -heatmap_plot <- pheatmap(as.matrix(res_tmp$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_colnames=TRUE, - cluster_cols = par_tmp$Heatmap$cluster_cols, - cluster_rows = clusterRowspossible, - scale=ifelse(par_tmp$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$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] -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$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] -# select to selection of processed data -annoToSelect=unique(c(colData(res_tmp$data)[,par_tmp$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$SingleEntVis -P_boxplots <- ggplot(res_tmp$SingleEntVis, - aes(y=res_tmp$SingleEntVis[,colnames(res_tmp$SingleEntVis)[-ncol(res_tmp$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)+ - 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 - #stat_compare_means(method = "anova")+ # Add global annova p-value - stat_compare_means(comparisons = par_tmp$SingleEntVis$chooseComparisons_list, - method = par_tmp$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)]], - 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)+ - 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$data)[,par_tmp$SampleCorr$SampleAnnotationChoice,drop = F] -cormat <- cor( - x = as.matrix(assay(res_tmp$data)), - method = par_tmp$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 -)' - } -## Significance Analysis ----- -### Venn Diagram ---- - if(numberOfScenario == 20){ - stringtosave <- 'VennDiagramm <- ggVennDiagram::ggVennDiagram(res_tmp$SignificanceAnalysis)' - } -### Upset plot ---- - if(numberOfScenario == 21){ - stringtosave <- 'UpSetR::upset(fromList(res_tmp$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)) -} diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R index d04fba0e..9582a897 100644 --- a/program/shinyApp/R/heatmap/server.R +++ b/program/shinyApp/R/heatmap/server.R @@ -220,7 +220,7 @@ heatmap_server <- function(id, data, params, updates){ ) req(selectedData_processed()) # update the data if needed - data <- update_data(data, updates, heatmap_reactives$current_updates) + data <- update_data(session$token) heatmap_reactives$current_updates <- updates() print("Heatmap on selected Data") # Value need to be setted in case there is nothing to plot to avoid crash @@ -360,7 +360,6 @@ heatmap_server <- function(id, data, params, updates){ } if(calculate == 1){ if(input$LFC_toHeatmap){ - browser() ctrl_samples_idx <- which( colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_ref_heatmap ) @@ -372,7 +371,7 @@ heatmap_server <- function(id, data, params, updates){ output$Options_selected_out_3 <- renderText("Choose variable with at least two samples per condition!") doThis_flag <- F } - if(par_tmp$PreProcessing_Procedure == "simpleCenterScaling"| + if(par_tmp[[session$token]]$PreProcessing_Procedure == "simpleCenterScaling"| any(assay(data$data))< 0){ print("Remember do not use normal center + scaling (negative Values!)") @@ -453,15 +452,15 @@ heatmap_server <- function(id, data, params, updates){ } else { print("Plotting saved result") if(input$LFC_toHeatmap){ - myBreaks <- c(seq(min(res_tmp$Heatmap$LFC), 0, length.out=ceiling(paletteLength/2) + 1), - seq(max(res_tmp$Heatmap$LFC)/paletteLength, max(res_tmp$Heatmap$LFC), length.out=floor(paletteLength/2))) + myBreaks <- c(seq(min(res_tmp[[session$token]]$Heatmap$LFC), 0, length.out=ceiling(paletteLength/2) + 1), + seq(max(res_tmp[[session$token]]$Heatmap$LFC)/paletteLength, max(res_tmp[[session$token]]$Heatmap$LFC), length.out=floor(paletteLength/2))) annotation_col <- rowData(data2Plot)[,input$row_anno_options,drop=F] scenario <- 10 heatmap_plot <- pheatmap( - t(res_tmp$Heatmap[,"LFC",drop=F]), + t(res_tmp[[session$token]]$Heatmap[,"LFC",drop=F]), main = gsub("^Heatmap","Heatmap_LFC",customTitleHeatmap), - show_rownames = ifelse(nrow(res_tmp$Heatmap)<=25,TRUE,FALSE), + show_rownames = ifelse(nrow(res_tmp[[session$token]]$Heatmap)<=25,TRUE,FALSE), show_colnames = TRUE, cluster_cols = input$cluster_cols, cluster_rows = FALSE, @@ -472,12 +471,12 @@ heatmap_server <- function(id, data, params, updates){ color = myColor_fill ) } else { - clusterRowspossible <- ifelse(nrow(as.matrix(res_tmp$Heatmap))>1,input$cluster_rows,F) - if(any(is.na(res_tmp$Heatmap))){ - idx_of_nas <- which(apply(res_tmp$Heatmap,1,is.na)) # why do we produce Nas? + clusterRowspossible <- ifelse(nrow(as.matrix(res_tmp[[session$token]]$Heatmap))>1,input$cluster_rows,F) + if(any(is.na(res_tmp[[session$token]]$Heatmap))){ + idx_of_nas <- which(apply(res_tmp[[session$token]]$Heatmap,1,is.na)) # why do we produce Nas? print(idx_of_nas) if(length(idx_of_nas)>0){ - res_tmp$Heatmap <- res_tmp$Heatmap[-idx_of_nas,] + res_tmp[[session$token]]$Heatmap <- res_tmp[[session$token]]$Heatmap[-idx_of_nas,] } annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F] @@ -494,9 +493,9 @@ heatmap_server <- function(id, data, params, updates){ } scenario <- 11 heatmap_plot <- pheatmap( - as.matrix(res_tmp$Heatmap), + as.matrix(res_tmp[[session$token]]$Heatmap), main = customTitleHeatmap, - show_rownames = ifelse(nrow(res_tmp$Heatmap)<=input$row_label_no,TRUE,FALSE), + show_rownames = ifelse(nrow(res_tmp[[session$token]]$Heatmap)<=input$row_label_no,TRUE,FALSE), labels_row = rowData(data$data)[rownames(data2HandOver),input$row_label_options], show_colnames = TRUE, cluster_cols = input$cluster_cols, @@ -531,27 +530,27 @@ heatmap_server <- function(id, data, params, updates){ # Heatmap_Groups2Compare_ctrl_heatmap <- input$Groups2Compare_ctrl_heatmap - # res_tmp gets data2HandOver or Data2Plot depending on scenario + # res_tmp[[session$token]] gets data2HandOver or Data2Plot depending on scenario if(scenario == 10){ - res_tmp[["Heatmap"]] <<- Data2Plot + res_tmp[[session$token]][["Heatmap"]] <<- Data2Plot }else if(scenario == 11){ - res_tmp[["Heatmap"]] <<- data2HandOver + res_tmp[[session$token]][["Heatmap"]] <<- data2HandOver } - # par_tmp gets the parameters used for the heatmap + # par_tmp[[session$token]] gets the parameters used for the heatmap ## This exports all reactive Values in the PCA namespace tmp <- getUserReactiveValues(input) - par_tmp$Heatmap[names(tmp)] <<- tmp + par_tmp[[session$token]]$Heatmap[names(tmp)] <<- tmp output$getR_Code_Heatmap <- downloadHandler( filename = function(){ - paste("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip", sep = "") + paste0("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip") }, content = function(file){ - envList=list( - - res_tmp=res_tmp, - par_tmp=par_tmp + # TODO: I think these are the completely wrong objects to save here. Needs Check! + envList <- list( + res_tmp = res_tmp[[session$token]], + par_tmp = par_tmp[[session$token]] ) temp_directory <- file.path(tempdir(), as.integer(Sys.time())) @@ -572,8 +571,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)) @@ -581,7 +580,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, @@ -620,8 +619,8 @@ heatmap_server <- function(id, data, params, updates){ ) output$SaveGeneList_Heatmap <- downloadHandler( - filename = function() { - paste("GeneList_",customTitleHeatmap, " ",Sys.time(),".csv",sep="") + filename = function() { + paste0("GeneList_", customTitleHeatmap, " ", Sys.time(), ".csv") }, content = function(file){ diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R index 39b2d935..8ec16db9 100644 --- a/program/shinyApp/R/pca/server.R +++ b/program/shinyApp/R/pca/server.R @@ -193,7 +193,7 @@ pca_Server <- function(id, data, params, row_select, updates){ if(pca_reactives$calculate >= 0){ # update the data if needed # TODO check if the follwoing still needed as update is now done on 1st server level - data2plot <- update_data(data, updates, pca_reactives$current_updates) + data2plot <- update_data(session$token) # select the neccesary data if(input$data_selection_pca){ data2plot <- select_data( @@ -324,9 +324,9 @@ pca_Server <- function(id, data, params, row_select, updates){ pca_reactives$df_loadings <- df_loadings # assign res_temp - res_tmp[["PCA"]] <<- list(pca) + res_tmp[[session$token]][["PCA"]] <<- list(pca) # assign par_temp as empty list - par_tmp[["PCA"]] <<- list( + par_tmp[[session$token]][["PCA"]] <<- list( # add a dummy parameter to avoid error dummy = "dummy", sample_selection_pca = input$sample_selection_pca, diff --git a/program/shinyApp/R/pca/util.R b/program/shinyApp/R/pca/util.R index 26bd3c60..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){ - if (is.null(res_tmp[[module]])){ # chec whether result is existent + if (is.null(res_tmp[[session$token]][[module]])){ # chec whether result is existent return("No Result yet") } # check whether all parameters are identical to the current existing result - if (identical(par_tmp[[module]], current_parameters)){ + if (identical(par_tmp[[session$token]][[module]], current_parameters)){ return("Result exists") } # The remaining case is an existing result with other parameters, diff --git a/program/shinyApp/R/sample_correlation/server.R b/program/shinyApp/R/sample_correlation/server.R index fe44d197..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, updates, sample_corr_reactive$current_updates) + data <- update_data(session$token) sample_corr_reactive$current_updates <- updates() # set the counter to 0 to prevent any further plotting sample_corr_reactive$calculate <- 0 @@ -53,7 +53,7 @@ sample_correlation_server <- function(id, data, params, updates){ data_info = list( rows = length(rownames(data$data)), cols = length(colnames(data$data)), - preprocessing = par_tmp$PreProcessing_Procedure + preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure ) ), "SampleCorrelation" @@ -70,7 +70,7 @@ sample_correlation_server <- function(id, data, params, updates){ output$SampleCorr_Info <- renderText( "Correlation Matrix was already computed, no need to click the Button again." ) - cormat <- res_tmp$SampleCorrelation + cormat <- res_tmp[[session$token]]$SampleCorrelation } else if (check == "Overwrite"){ output$SampleCorr_Info <- renderText( "Correlation Matrix result overwritten with different parameters." @@ -122,14 +122,14 @@ sample_correlation_server <- function(id, data, params, updates){ annotation_colors = anno_colors ) # assign res_temp["SampleCorrelation"] - res_tmp[["SampleCorrelation"]] <<- cormat + res_tmp[[session$token]][["SampleCorrelation"]] <<- cormat # assign par_temp["SampleCorrelation"] - par_tmp[["SampleCorrelation"]] <<- list( + par_tmp[[session$token]][["SampleCorrelation"]] <<- list( corrMethod = input$corrMethod, data_info = list( rows = length(rownames(data$data)), cols = length(colnames(data$data)), - preprocessing = par_tmp$PreProcessing_Procedure + preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure ) ) @@ -141,7 +141,7 @@ sample_correlation_server <- function(id, data, params, updates){ customTitleSampleCorrelation <- "SampleCorrelation" } - par_tmp[["SampleCorr"]] <<- list( + par_tmp[[session$token]][["SampleCorr"]] <<- list( customTitleSampleCorrelation = customTitleSampleCorrelation, SampleCorrelationPlot_final = SampleCorrelationPlot_final, cormat = cormat, @@ -161,16 +161,16 @@ sample_correlation_server <- function(id, data, params, updates){ }, content = function(file){ envList = list( - cormat = ifelse(exists("cormat"),par_tmp[["SampleCorr"]]$cormat,NA), - annotationDF = ifelse(exists("annotationDF"),par_tmp[["SampleCorr"]]$annotationDF,NA), - customTitleSampleCorrelation = ifelse(exists("customTitleSampleCorrelation"),par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,NA), - anno_colors = ifelse(exists("anno_colors"),par_tmp[["SampleCorr"]]$anno_colors,NA) + cormat = ifelse(exists("cormat"),par_tmp[[session$token]][["SampleCorr"]]$cormat,NA), + annotationDF = ifelse(exists("annotationDF"),par_tmp[[session$token]][["SampleCorr"]]$annotationDF,NA), + customTitleSampleCorrelation = ifelse(exists("customTitleSampleCorrelation"),par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,NA), + anno_colors = ifelse(exists("anno_colors"),par_tmp[[session$token]][["SampleCorr"]]$anno_colors,NA) ) temp_directory <- file.path(tempdir(), as.integer(Sys.time())) dir.create(temp_directory) - write(getPlotCode(par_tmp[["SampleCorr"]]$sampleCorrelation_scenario), file.path(temp_directory, "Code.R")) + write(getPlotCode(par_tmp[[session$token]][["SampleCorr"]]$sampleCorrelation_scenario), file.path(temp_directory, "Code.R")) saveRDS(envList, file.path(temp_directory, "Data.RDS")) zip::zip( @@ -184,18 +184,18 @@ sample_correlation_server <- function(id, data, params, updates){ output$SavePlot_SampleCorrelation <- downloadHandler( filename = function() { - paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_Heatmap,sep = "") + paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_Heatmap,sep = "") }, content = function(file){ - save_pheatmap(par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final,filename = file,type=gsub("\\.","",input$file_ext_SampleCorrelation)) + save_pheatmap(par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final,filename = file,type=gsub("\\.","",input$file_ext_SampleCorrelation)) on.exit({ tmp_filename <- paste0( getwd(), "/www/", - paste(paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_SampleCorrelation,sep = "")) + paste(paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),input$file_ext_SampleCorrelation,sep = "")) ) save_pheatmap( - par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final, + par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final, filename = tmp_filename, type = gsub("\\.","",input$file_ext_SampleCorrelation) ) @@ -216,11 +216,11 @@ sample_correlation_server <- function(id, data, params, updates){ tmp_filename <- paste0( getwd(), "/www/", - paste(paste(par_tmp[["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = "")) + paste(paste(par_tmp[[session$token]][["SampleCorr"]]$customTitleSampleCorrelation,Sys.time(),".png",sep = "")) ) save_pheatmap( - par_tmp[["SampleCorr"]]$SampleCorrelationPlot_final, + par_tmp[[session$token]][["SampleCorr"]]$SampleCorrelationPlot_final, filename = tmp_filename, type = "png" ) diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index 24c2bfc4..d88beafc 100644 --- a/program/shinyApp/R/significance_analysis/server.R +++ b/program/shinyApp/R/significance_analysis/server.R @@ -180,8 +180,8 @@ significance_analysis_server <- function(id, data, params, updates){ ) # refresh the UI/data if needed observeEvent(input$refreshUI, { - data <- update_data(data, updates, sig_ana_reactive$current_updates) - params <- update_params(params, updates, sig_ana_reactive$current_updates) + data <- update_data(session$token) + params <- update_params(session$token) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) }) @@ -200,7 +200,7 @@ significance_analysis_server <- function(id, data, params, updates){ } print("Start the Significance Analysis") # update the data if needed - data <- update_data(data, updates, sig_ana_reactive$current_updates) + data <- update_data(session$token) sig_ana_reactive$current_updates <- updates() sig_ana_reactive$coldata <- colData(data$data) # delete old panels @@ -228,10 +228,10 @@ significance_analysis_server <- function(id, data, params, updates){ for (i in 1:length(contrasts)) { if(identical( list(test_method = "Wald", test_correction = PADJUST_METHOD[[input$test_correction]]), - par_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] + par_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] )){ print("Results exists, skipping calculations.") - sig_results[[input$comparisons[i]]] <<- res_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] + sig_results[[input$comparisons[i]]] <<- res_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] next } sig_results[[input$comparisons[i]]] <<- DESeq2::results( @@ -243,9 +243,9 @@ significance_analysis_server <- function(id, data, params, updates){ ), pAdjustMethod = PADJUST_METHOD[[input$test_correction]] ) - # fill in res_tmp, par_tmp - res_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]] - par_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- list( + # fill in res_tmp[[session$token]], par_tmp[[session$token]] + res_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- sig_results[[input$comparisons[i]]] + par_tmp[[session$token]]$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]] <<- list( test_method = "Wald", test_correction = PADJUST_METHOD[[input$test_correction]] ) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 26fa9fb2..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$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$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, 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$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$PreProcessing_Procedure == "log10"){ + if(par_tmp[[session$token]]$PreProcessing_Procedure == "log10"){ lfc_per_gene_log(means, log_base = 10) - }else if(par_tmp$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 3ab63e5e..7a08f6f8 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(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, updates, single_Gene_vis$current_updates) + 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 @@ -261,11 +261,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$token]][["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$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, @@ -313,7 +313,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$token]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), input$file_ext_singleGene,sep="" @@ -323,7 +323,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ content = function(file){ ggsave( file = file, - plot = res_tmp$SingleEntVis, + plot = res_tmp[[session$token]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) @@ -332,14 +332,14 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp$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$SingleEntVis, + plot = res_tmp[[session$token]]$SingleEntVis, device = gsub("\\.","",input$file_ext_singleGene) ) fun_LogIt("## Single Entitie") @@ -367,7 +367,7 @@ single_gene_visualisation_server <- function(id, data, params, updates){ getwd(), "/www/", paste( - par_tmp$SingleEntVis$SingleEnt_customTitle_boxplot, + par_tmp[[session$token]]$SingleEntVis$SingleEnt_customTitle_boxplot, " ", Sys.time(), ".png", @@ -375,27 +375,27 @@ single_gene_visualisation_server <- function(id, data, params, updates){ ) ggsave( filename = tmp_filename, - plot = res_tmp$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$SingleEntVis$SingleEnt_Select_Gene)) + par_tmp[[session$token]]$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$token]]$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$token]]$SingleEntVis$SingleEnt_accross_condition, " (", - paste0(levels(par_tmp$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$SingleEntVis$SingleEnt_testMethod)) + par_tmp[[session$token]]$SingleEntVis$SingleEnt_testMethod)) - if(length(levels(par_tmp$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 07fd6130..e07705f5 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, updates, current_updates){ +update_data <- function(session_id){ # for stability reasons, data is ALWAYS pulled here print("Updating data...") - data <- res_tmp + data <- res_tmp[[session_id]] return(data) } @@ -27,13 +27,11 @@ select_data <- function(data, selected_samples, sample_type){ } -update_params <- function(params, updates, current_updates){ +update_params <- function(session_id){ # 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 - } + print("Updating parameters...") + params <- par_tmp[[session_id]] return(params) } diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index b00d5d0c..a5f86917 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -1,7 +1,12 @@ server <- function(input,output,session){ source("R/SourceAll.R",local=T) source("R/util.R") - + + # 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? @@ -65,9 +70,19 @@ 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$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 + }) # 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 @@ -184,7 +199,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$token]]$data_original, file = file ) } @@ -342,11 +357,11 @@ server <- function(input,output,session){ ## Do Upload ---- observeEvent(input$refresh1,{ - par_tmp['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['omic_type']) + message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp[[session$token]]['omic_type']) ) if(!(isTruthy(input$data_preDone) | FLAG_TEST_DATA_SELECTED() | @@ -358,8 +373,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$token]]['omic_type'],"Data Upload"), + text = paste0(par_tmp[[session$token]]['omic_type'],"-data upload was successful"), position = "top", timer = 1500, timerProgressBar = T @@ -488,25 +503,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$token]][['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$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$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$token]]$data_original) + )) + 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$data))) + print(paste0( + "(after) No. anno options sample_table: ",ncol(res_tmp[[session$token]]$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$token]]$data_original) + )) - rowData(res_tmp$data) <- - DataFrame(as.data.frame(rowData(res_tmp$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$data))) + print(paste0( + "(after) No. anno options annotation_rows: ",ncol(res_tmp[[session$token]]$data) + )) fun_LogIt( message = @@ -514,13 +537,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$token]]$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$token]]$omic_type, + data_dimension = paste0(dim(res_tmp[[session$token]]$data_original),collapse = ", ") )) fun_LogIt(message = "
") return("DataUploadSuccesful") @@ -532,14 +555,14 @@ server <- function(input,output,session){ ## Ui Section ---- observe({ req(data_input_shiny()) - isTruthy(res_tmp$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$data_original))), + choices = c(colnames(rowData(res_tmp[[session$token]]$data_original))), multiple = F, search = T, showSelectedOptionsFirst = T @@ -549,7 +572,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$token]]$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!)", @@ -561,7 +586,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$token]]$data_original)[,input$providedRowAnnotationTypes],"\\|")))), selected = "all", multiple = T, search = T, @@ -592,8 +617,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$token]]$data_original))), + selected = c(colnames(colData(res_tmp[[session$token]]$data_original)))[1], multiple = F ) }) @@ -602,9 +627,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$token]]$data_original)[,input$providedSampleAnnotationTypes]) + ), selected = "all", multiple = T ) @@ -656,17 +682,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$token]][["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$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$data_original))[ - which(rowData(res_tmp$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) ] ) ) @@ -674,17 +700,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$token]]$data_original), prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp$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$data_original)[selected,], + rna = assay(res_tmp[[session$token]]$data_original)[selected,], prop = input$propensityChoiceUser ) - filteredIQR_Expr <- assay(res_tmp$data_original)[toKeep,] + filteredIQR_Expr <- assay(res_tmp[[session$token]]$data_original)[toKeep,] selected <- intersect( selected, rownames(filteredIQR_Expr) @@ -696,20 +722,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$token]]$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$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$data <<- res_tmp$data_original[selected,samples_selected] - tmp_data_selected <<- res_tmp$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") }) @@ -790,42 +816,42 @@ server <- function(input,output,session){ print("Do Preprocessing") print(selectedData()) addWarning <- "" - par_tmp['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$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$data)) + print(dim(res_tmp[[session$token]]$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$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$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$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$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$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$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$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$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)) @@ -833,27 +859,27 @@ server <- function(input,output,session){ } } - print(dim(res_tmp$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$data)))), + x = as.data.frame(t(as.data.frame(assay(res_tmp[[session$token]]$data)))), scale = T, center = T ) ) ) - assay(res_tmp$data) <<- as.data.frame(processedData) + assay(res_tmp[[session$token]]$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$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$data)[,input$DESeq_formula_main] <- as.factor( - colData(res_tmp$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( @@ -862,63 +888,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$token]]$data)[,i] <- as.factor( + colData(res_tmp[[session$token]]$data)[,i] ) } - par_tmp[["DESeq_factors"]] <<- c( + par_tmp[[session$token]][["DESeq_factors"]] <<- c( input$DESeq_formula_main,input$DESeq_formula_sub ) } else{ - par_tmp[["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["DESeq_advanced"] <<- TRUE + par_tmp[[session$token]]["DESeq_advanced"] <<- TRUE } } print(design_formula) - par_tmp["DESeq_formula"] <<- design_formula + par_tmp[[session$token]]["DESeq_formula"] <<- design_formula # on purpose local - print(colData(res_tmp$data)[,input$DESeq_formula_main]) + print(colData(res_tmp[[session$token]]$data)[,input$DESeq_formula_main]) dds <- DESeq2::DESeqDataSetFromMatrix( - countData = assay(res_tmp$data), - colData = colData(res_tmp$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$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$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$data),1,function(x){ + apply(assay(res_tmp[[session$token]]$data),1,function(x){ (x - min(x))/(max(x) - min(x)) }) )) - assay(res_tmp$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$data)) + as.data.frame(assay(res_tmp[[session$token]]$data)) )) - assay(res_tmp$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$data)) + processedData <- as.data.frame(assay(res_tmp[[session$token]]$data)) if(any(processedData<0)){ addWarning <- "Negative entries, cannot take log10!!" } @@ -930,10 +956,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$token]]$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$token]]$data)) centered <- as.data.frame(t( apply(processedData, 1, function(x){x - mean(x)}) )) @@ -941,22 +967,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$token]]$data) <<- as.data.frame(pareto.matrix) } } - if(any(is.na(assay(res_tmp$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$data)) - nrow_after <- nrow(res_tmp$data[complete.cases(assay(res_tmp$data)),]) + nrow_before <- nrow(assay(res_tmp[[session$token]]$data)) + nrow_after <- nrow( + 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$data <<- res_tmp$data[complete.cases(assay(res_tmp$data)),] + res_tmp[[session$token]]$data <<- res_tmp[[session$token]]$data[complete.cases(assay(res_tmp[[session$token]]$data)),] } - print(colnames(res_tmp$data)) + print(colnames(res_tmp[[session$token]]$data)) showTab(inputId = "tabsetPanel1", target = "Sample Correlation") showTab(inputId = "tabsetPanel1", target = "Significance Analysis") @@ -975,11 +1003,11 @@ server <- function(input,output,session){ shinyjs::click("EnrichmentAnalysis-refreshUI",asis = T) paste0(addWarning, "The data has the dimensions of: ", - paste0(dim(res_tmp$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$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","")) }) @@ -1004,9 +1032,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$token]]$omic_type == "Transcriptomics"){ tmp_logMessage <- "Remove anything which row Count <= 10" - }else if(par_tmp$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" @@ -1022,19 +1050,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$token]]$data),collapse = ", ") ) + ) }) - output$debug <- renderText(dim(res_tmp$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, - params = par_tmp, + 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? @@ -1043,30 +1074,30 @@ server <- function(input,output,session){ # significance analysis ---- significance_analysis_server( id = 'SignificanceAnalysis', - data = res_tmp, - params = par_tmp, + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) # PCA ---- pca_Server( id = "PCA", - data = res_tmp, - params = par_tmp, + 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, - params = par_tmp, + 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, - params = par_tmp, + data = res_tmp[[session$token]], + params = par_tmp[[session$token]], reactive(updating$count) ) @@ -1074,8 +1105,8 @@ server <- function(input,output,session){ # Enrichment Analysis ---- enrichment_analysis_Server( id = 'EnrichmentAnalysis', - data = res_tmp, - params = par_tmp, + 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 930dc41b..40dc68d6 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", ################################################################################ @@ -234,6 +235,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 ) ) diff --git a/program/shinyApp/www/Report.md b/program/shinyApp/www/Report.md deleted file mode 100644 index 1bb580d0..00000000 --- a/program/shinyApp/www/Report.md +++ /dev/null @@ -1,41 +0,0 @@ -# ShinyOmics Report (18/12/2023) - **AppVersion: 0.1.3 (2022-12-02)** - -## DataInput {.tabset .tabset-fade} - -### Info - -**DataInput** - Uploaded Omic Type: Transcriptomics - -**DataInput** - Test Data set used - -**DataInput** - All constant annotation entries for entities and samples are removed from the thin out the selection options! - -**DataInput** - The raw data dimensions are:33469, 8 - -### Publication Snippet - -The Transcriptomics data was read into R (v. 4.2.1) (R Core Team (2022). _R: A Language and Environment for Statistical Computing_. R Foundationfor Statistical Computing, Vienna, Austria. .). The raw's data dimensions were: 33469, 8. All annotation that is constant over all samples is hidden within the Shiny-Application, as they do not provide any additional knowledge.This was done with the purrr package (v. 1.0.2)(Wickham H, Henry L (2023). _purrr: Functional Programming Tools_. R package version 1.0.2,.) - -
- -## Data Selection - -**DataSelection** - The following selection was conducted: - -**DataSelection** - Samples: - DataSelection - based on: cell: all - -**DataSelection** - Entities: - DataSelection - based on: geneName: all - -## Pre Processing - -**PreProcessing** - As general remove all entities which are constant over all samples (automatically) - -**PreProcessing** - Preprocessing procedure -standard (depending only on omics-type): Remove anything which row Count <= 10 - -**PreProcessing** - Preprocessing procedure -specific (user-chosen): filterOnly - -**PreProcessing** - The resulting dimensions are: 22008, 8 -