diff --git a/program/shinyApp/R/SourceAll.R b/program/shinyApp/R/SourceAll.R
index ce4ea3a6..b20c39b9 100644
--- a/program/shinyApp/R/SourceAll.R
+++ b/program/shinyApp/R/SourceAll.R
@@ -1,6 +1,5 @@
source("R/fun_filterRNA.R",local = T)
source("R/fun_LFC.R",local = T)
-source("R/fun_volcano.R",local = T)
source("R/fun_popupModal.R",local = T)
source("R/heatmap/fun_entitieSelection.R",local = T)
source("R/fun_savePheatmap.R",local = T)
@@ -16,7 +15,7 @@ source("R/enrichment_analysis/translation.R", local = T)
source("R/enrichment_analysis/server.R", local = T)
source("R/heatmap/server.R",local = T)
source("R/pca/server.R", local = T)
-source("R/volcano_plot/server.R", local = T)
+source("R/pca/util.R", local = T)
source("R/single_gene_visualisation/server.R",local = T)
source("R/sample_correlation/server.R", local = T)
source("R/significance_analysis/server.R", local = T)
diff --git a/program/shinyApp/R/data_selection/ui.R b/program/shinyApp/R/data_selection/ui.R
index 7e197559..def10961 100644
--- a/program/shinyApp/R/data_selection/ui.R
+++ b/program/shinyApp/R/data_selection/ui.R
@@ -24,7 +24,7 @@ data_selection_sidebar_panel <- sidebarPanel(
),
div(
class = "DataSelection",
- h4("Row selection - biochemical entities"),
+ h4("Row selection - biochemical entities") %>% helper(type = "markdown", content = "DataSelection_RowSelection"),
uiOutput(outputId = "providedRowAnnotationTypes_ui"),
uiOutput(outputId = "row_selection_ui"),
uiOutput(outputId = "propensityChoiceUser_ui")
@@ -58,38 +58,38 @@ data_selection_main_panel <- mainPanel(
actionButton(
inputId = "Reset",
label = "Reset"
- ),
+ ) %>% helper(type = "markdown", content = "DataSelection_Reset"),
NULL
),
hr(style = "border-top: 2px solid #90DBF4;"),
a(id = "toggleAdvanced",
"Data Upload via file input",
style = "background-color: #90DBF4; color: black; padding: 7px 10px; "
- ),
+ ) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"),
shinyjs::hidden(
div(
id = "advanced",
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("50%", "50%"),
- uiOutput(outputId = "data_matrix1_ui"),
- uiOutput(outputId = "data_sample_anno1_ui")
+ uiOutput(outputId = "data_matrix1_ui") %>% helper(type = "markdown", content = "DataSelection_Matrix"),
+ uiOutput(outputId = "data_sample_anno1_ui") %>% helper(type = "markdown", content = "DataSelection_SampleAnno")
),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("50%", "50%"),
- uiOutput(outputId = "data_row_anno1_ui"),
+ uiOutput(outputId = "data_row_anno1_ui") %>% helper(type = "markdown", content = "DataSelection_RowAnno"),
uiOutput(
outputId = "data_preDone_ui"
- ) %>% helper(type = "markdown", content = "SummarizedExp_help")
+ ) %>% helper(type = "markdown", content = "DataSelection_SummarizedExp")
)
)
),
hr(style = "border-top: 2px solid #90DBF4;"),
- uiOutput(outputId = "metadataInput_ui"),
+ uiOutput(outputId = "metadataInput_ui") %>% helper(type = "markdown", content = "DataSelection_MetaData"),
hr(style = "border-top: 2px solid #90DBF4;"),
downloadButton(
outputId = "SaveInputAsList",
label = "Save file input to upload later"
- ) %>% helper(type = "markdown", content = "compilation_help"),
+ ) %>% helper(type = "markdown", content = "DataSelection_compilation_help"),
htmlOutput(outputId = "debug", container = pre),
HTML(text = "
"),
HTML(text = "
")),
@@ -99,7 +99,7 @@ data_selection_main_panel <- mainPanel(
actionButton(
inputId = "DoVisualDataInspection",
label = "Upload data for visual inspection"
- ),
+ ) %>% helper(type = "markdown", content = "DataSelection_UploadInspection"),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("70%", "30%"),
DT::dataTableOutput("DataMatrix_VI"),
diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R
index 49d1a6c3..32a7a091 100644
--- a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R
+++ b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R
@@ -1,16 +1,20 @@
gene_set_enrichment <- function(
input,
- output,
geneSetChoice,
data,
enrichments2do,
- adjustMethod
+ adjustMethod,
+ comp_type,
+ ref,
+ treat,
+ sorting
){
# assign the correct names to geneSetChoice
names(geneSetChoice) <- rowData(data)[["ENTREZID"]]
geneSetChoice <- sort(geneSetChoice,decreasing = T)
# remove duplicate entries (keep the one highest in list)
geneSetChoice <- geneSetChoice[!duplicated(names(geneSetChoice))]
+ contrast <- paste(treat,ref,sep=":")
# set all results to NULL in case some are not to be computed
EnrichmentRes_Hallmarks <- NULL
@@ -44,455 +48,689 @@ gene_set_enrichment <- function(
EnrichmentRes_C8 <- NULL
if(enrichments2do$KEGG){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:KEGG"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_Kegg <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$KEGG ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:KEGG"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_Kegg <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_Kegg <- res_tmp$EA[[comp_type]][[contrast]]$KEGG
+ }
}
if(enrichments2do$GO){
- EnrichmentRes_GO <- clusterProfiler::gseGO(
- gene = geneSetChoice,
- ont = input$ontologyForGO,
- keyType = "ENTREZID",
- minGSSize = 3,
- maxGSSize = 800,
- pvalueCutoff = 0.05,
- verbose = TRUE,
- OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db"),
- pAdjustMethod = "none" # TODO: discuss
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO ))
+ ){
+ EnrichmentRes_GO <- clusterProfiler::gseGO(
+ gene = geneSetChoice,
+ ont = input$ontologyForGO,
+ keyType = "ENTREZID",
+ minGSSize = 3,
+ maxGSSize = 800,
+ pvalueCutoff = 0.05,
+ verbose = TRUE,
+ OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db"),
+ pAdjustMethod = "none" # TODO: discuss
+ )
+ res_tmp$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO
+ par_tmp$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting)
+ }else{
+ EnrichmentRes_GO <- res_tmp$EA[[comp_type]][[contrast]]$GO
+ }
}
+ # Hallmarks
if(enrichments2do$Hallmarks){
- # Hallmarks
- Hallmarkset <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "H",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_Hallmarks <- GSEA(
- geneSetChoice,
- TERM2GENE = Hallmarkset,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$Hallmarks ))
+ ){
+ Hallmarkset <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "H",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_Hallmarks <- GSEA(
+ geneSetChoice,
+ TERM2GENE = Hallmarkset,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_Hallmarks <- res_tmp$EA[[comp_type]][[contrast]]$Hallmarks
+ }
}
+ # C1
if(enrichments2do$C1){
- # C1
- C1set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C1",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C1 <- GSEA(
- geneSetChoice,
- TERM2GENE = C1set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C1 ))
+ ){
+ C1set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C1",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C1 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C1set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C1 <- res_tmp$EA[[comp_type]][[contrast]]$C1
+ }
+
}
+ # C2
if(enrichments2do$C2){
- # C2
- C2set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C2 <- GSEA(
- geneSetChoice,
- TERM2GENE = C2set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C2 ))
+ ){
+ C2set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C2 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C2set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C2 <- res_tmp$EA[[comp_type]][[contrast]]$C2
+ }
}
+ # C3
if(enrichments2do$C3){
- # C3
- C3set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C3 <- GSEA(
- geneSetChoice,
- TERM2GENE = C3set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C3 ))
+ ){
+ C3set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C3 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C3set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C3 <- res_tmp$EA[[comp_type]][[contrast]]$C3
+ }
}
+ # C4
if(enrichments2do$C4){
- # C4
- C4set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C4 <- GSEA(
- geneSetChoice,
- TERM2GENE = C4set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C4 ))
+ ){
+ C4set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C4 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C4set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C4 <- res_tmp$EA[[comp_type]][[contrast]]$C4
+ }
}
# C5
if(enrichments2do$C5){
- C5set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C5 <- GSEA(
- geneSetChoice,
- TERM2GENE = C5set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C5 ))
+ ){
+ C5set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C5 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C5set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C5 <- res_tmp$EA[[comp_type]][[contrast]]$C5
+ }
}
# C6
if(enrichments2do$C6){
- C6set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C6",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C6 <- GSEA(
- geneSetChoice,
- TERM2GENE = C6set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C6 ))
+ ){
+ C6set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C6",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C6 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C6set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C6 <- res_tmp$EA[[comp_type]][[contrast]]$C6
+ }
}
# C7
if(enrichments2do$C7){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C7 <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C7 ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C7 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C7 <- res_tmp$EA[[comp_type]][[contrast]]$C7
+ }
}
# C8
if(enrichments2do$C8){
- C8set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C8",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C8 <- GSEA(
- geneSetChoice,
- TERM2GENE = C8set,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C8 ))
+ ){
+ C8set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C8",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C8 <- GSEA(
+ geneSetChoice,
+ TERM2GENE = C8set,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_C8 <- res_tmp$EA[[comp_type]][[contrast]]$C8
+ }
}
# C2 subset CGP
if(enrichments2do$CGP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CGP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CGP <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGP ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CGP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CGP <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_CGP <- res_tmp$EA[[comp_type]][[contrast]]$CGP
+ }
}
# C2 subset CP
if(enrichments2do$CP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CP <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CP ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CP <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_CP <- res_tmp$EA[[comp_type]][[contrast]]$CP
+ }
}
# C2:CP subset BIOCARTA
if(enrichments2do$BIOCARTA){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:BIOCARTA"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_BIOCARTA <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$BIOCARTA ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:BIOCARTA"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_BIOCARTA <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_BIOCARTA <- res_tmp$EA[[comp_type]][[contrast]]$BIOCARTA
+ }
}
# C2:CP subset PID
if(enrichments2do$PID){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:PID"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_PID <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$PID ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:PID"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_PID <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_PID <- res_tmp$EA[[comp_type]][[contrast]]$PID
+ }
}
# C2:CP subset REACTOME
if(enrichments2do$REACTOME){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:REACTOME"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_REACTOME <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$REACTOME ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:REACTOME"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_REACTOME <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_REACTOME <- res_tmp$EA[[comp_type]][[contrast]]$REACTOME
+ }
}
# C2:CP subset WIKIPATHWAYS
if(enrichments2do$WIKIPATHWAYS){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:WIKIPATHWAYS"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_WIKIPATHWAYS <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:WIKIPATHWAYS"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_WIKIPATHWAYS <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_WIKIPATHWAYS <- res_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS
+ }
}
# C3 subset MIR:MIRDB
if(enrichments2do$MIRDB){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "MIR:MIRDB"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_MIRDB <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$MIRDB ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "MIR:MIRDB"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_MIRDB <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_MIRDB <- res_tmp$EA[[comp_type]][[contrast]]$MIRDB
+ }
}
# C3 subset MIR:MIR_Legacy
if(enrichments2do$MIR_Legacy){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "MIR:MIR_Legacy"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_MIR_Legacy <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "MIR:MIR_Legacy"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_MIR_Legacy <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_MIR_Legacy <- res_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy
+ }
}
# C3 subset TFT:GTRD
if(enrichments2do$GTRD){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "TFT:GTRD"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GTRD <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GTRD ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "TFT:GTRD"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GTRD <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_GTRD <- res_tmp$EA[[comp_type]][[contrast]]$GTRD
+ }
}
# C3 subset TFT:TFT_Legacy
if(enrichments2do$TFT_Legacy){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "TFT:TFT_Legacy"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_TFT_Legacy <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "TFT:TFT_Legacy"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_TFT_Legacy <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_TFT_Legacy <- res_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy
+ }
}
# C4 subset CGN
if(enrichments2do$CGN){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- subcategory = "CGN"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CGN <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGN ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ subcategory = "CGN"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CGN <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_CGN <- res_tmp$EA[[comp_type]][[contrast]]$CGN
+ }
}
# C4 subset CM
if(enrichments2do$CM){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- subcategory = "CM"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CM <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CM ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ subcategory = "CM"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CM <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_CM <- res_tmp$EA[[comp_type]][[contrast]]$CM
+ }
}
# C5 subset GO BP
if(enrichments2do$GO_BP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:BP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_BP <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_BP ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:BP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_BP <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_GO_BP <- res_tmp$EA[[comp_type]][[contrast]]$GO_BP
+ }
}
# C5 subset GO CC
if(enrichments2do$GO_CC){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:CC"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_CC <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_CC ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:CC"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_CC <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_GO_CC <- res_tmp$EA[[comp_type]][[contrast]]$GO_CC
+ }
}
# C5 subset GO MF
if(enrichments2do$GO_MF){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:MF"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_MF <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO_MF ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:MF"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_MF <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_GO_MF <- res_tmp$EA[[comp_type]][[contrast]]$GO_MF
+ }
}
# C5 subset HPO
if(enrichments2do$HPO){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "HPO"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_HPO <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$HPO ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "HPO"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_HPO <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_HPO <- res_tmp$EA[[comp_type]][[contrast]]$HPO
+ }
}
# C7 subset IMMUNESIGDB
if(enrichments2do$IMMUNESIGDB){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7",
- subcategory = "IMMUNESIGDB"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_IMMUNESIGDB <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7",
+ subcategory = "IMMUNESIGDB"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_IMMUNESIGDB <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_IMMUNESIGDB <- res_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB
+ }
}
# C7 subset VAX
if(enrichments2do$VAX){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7",
- subcategory = "VAX"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_VAX <- GSEA(
- geneSetChoice,
- TERM2GENE = genesets4ea,
- verbose = FALSE,
- eps = 0,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- pvalueCutoff = 1
- )
+ if(
+ !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$VAX ))
+ ){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7",
+ subcategory = "VAX"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_VAX <- GSEA(
+ geneSetChoice,
+ TERM2GENE = genesets4ea,
+ verbose = FALSE,
+ eps = 0,
+ 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)
+ }else{
+ EnrichmentRes_VAX <- res_tmp$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 dfb5d2a2..c4720d8c 100644
--- a/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R
+++ b/program/shinyApp/R/enrichment_analysis/overrepresentation_analysis.R
@@ -42,7 +42,7 @@ over_representation_analysis <- function(
EnrichmentRes_CGP <- NULL
EnrichmentRes_CP <- NULL
EnrichmentRes_BIOCARTA <- NULL
- EnrichmentRes_Kegg <- NULL
+ EnrichmentRes_KEGG <- NULL
EnrichmentRes_PID <- NULL
EnrichmentRes_REACTOME <- NULL
EnrichmentRes_WIKIPATHWAYS <- NULL
@@ -67,428 +67,608 @@ over_representation_analysis <- function(
EnrichmentRes_C8 <- NULL
# KEGG
if(enrichments2do$KEGG){
- EnrichmentRes_Kegg <- clusterProfiler::enrichKEGG(
- gene = geneSetChoice,
- organism = input$OrganismChoice,
- pvalueCutoff = 0.05,
- universe = universeSelected_tranlsated
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$KEGG ))){
+ EnrichmentRes_KEGG <- clusterProfiler::enrichKEGG(
+ gene = geneSetChoice,
+ organism = input$OrganismChoice,
+ pvalueCutoff = 0.05,
+ universe = universeSelected_tranlsated
+ )
+ res_tmp$OA$KEGG <<- EnrichmentRes_KEGG
+ par_tmp$OA$KEGG <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_KEGG <- res_tmp$OA$KEGG
+ }
}
# GO
if(enrichments2do$GO){
- EnrichmentRes_GO <- clusterProfiler::enrichGO(
- gene = geneSetChoice,
- ont = input$ontologyForGO,
- pvalueCutoff = 0.05,
- OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db")
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO ))){
+ EnrichmentRes_GO <- clusterProfiler::enrichGO(
+ gene = geneSetChoice,
+ ont = input$ontologyForGO,
+ pvalueCutoff = 0.05,
+ OrgDb = ifelse(input$OrganismChoice == "hsa","org.Hs.eg.db","org.Mm.eg.db")
+ )
+ res_tmp$OA$GO <<- EnrichmentRes_GO
+ par_tmp$OA$GO <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_GO <- res_tmp$OA$GO
+ }
}
# Reactome
if(enrichments2do$REACTOME){
- EnrichmentRes_REACTOME <- ReactomePA::enrichPathway(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- organism = ifelse(input$OrganismChoice == "hsa","human","mouse"),
- universe = universeSelected_tranlsated,
- readable = T
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$REACTOME ))){
+ EnrichmentRes_REACTOME <- ReactomePA::enrichPathway(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ organism = ifelse(input$OrganismChoice == "hsa","human","mouse"),
+ universe = universeSelected_tranlsated,
+ readable = T
+ )
+ res_tmp$OA$REACTOME <<- EnrichmentRes_REACTOME
+ par_tmp$OA$REACTOME <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_REACTOME <- res_tmp$OA$REACTOME
+ }
}
# Hallmarks
if(enrichments2do$Hallmarks){
- Hallmarkset <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "H",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_Hallmarks <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = Hallmarkset
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$Hallmarks ))){
+ Hallmarkset <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "H",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_Hallmarks <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = Hallmarkset
+ )
+ res_tmp$OA$Hallmarks <<- EnrichmentRes_Hallmarks
+ par_tmp$OA$Hallmarks <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_Hallmarks <- res_tmp$OA$Hallmarks
+ }
}
# C1
if(enrichments2do$C1){
- C1set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C1",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C1 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C1set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C1 ))){
+ C1set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C1",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C1 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C1set
+ )
+ res_tmp$OA$C1 <<- EnrichmentRes_C1
+ par_tmp$OA$C1 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C1 <- res_tmp$OA$C1
+ }
}
# C2
if(enrichments2do$C2){
- C2set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C2 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C2set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C2 ))){
+ C2set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C2 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C2set
+ )
+ res_tmp$OA$C2 <<- EnrichmentRes_C2
+ par_tmp$OA$C2 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C2 <- res_tmp$OA$C2
+ }
}
# C3
if(enrichments2do$C3){
- C3set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C3 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C3set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C3 ))){
+ C3set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C3 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C3set
+ )
+ res_tmp$OA$C3 <<- EnrichmentRes_C3
+ par_tmp$OA$C3 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C3 <- res_tmp$OA$C3
+ }
}
# C4
if(enrichments2do$C4){
- C4set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C4 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C4set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C4 ))){
+ C4set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C4 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C4set
+ )
+ res_tmp$OA$C4 <<- EnrichmentRes_C4
+ par_tmp$OA$C4 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C4 <- res_tmp$OA$C4
+ }
}
# C5
if(enrichments2do$C5){
- C5set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C5 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C5set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C5 ))){
+ C5set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C5 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C5set
+ )
+ res_tmp$OA$C5 <<- EnrichmentRes_C5
+ par_tmp$OA$C5 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C5 <- res_tmp$OA$C5
+ }
}
# C6
if(enrichments2do$C6){
- C6set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C6",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C6 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C6set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C6 ))){
+ C6set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C6",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C6 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C6set
+ )
+ res_tmp$OA$C6 <<- EnrichmentRes_C6
+ par_tmp$OA$C6 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C6 <- res_tmp$OA$C6
+ }
}
# C7 ImmuneSigDB subset
if(enrichments2do$C7){
- C7set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7",
- subcategory = "IMMUNESIGDB"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C7 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C7set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C7 ))){
+ C7set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7",
+ subcategory = "IMMUNESIGDB"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C7 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C7set
+ )
+ res_tmp$OA$C7 <<- EnrichmentRes_C7
+ par_tmp$OA$C7 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C7 <- res_tmp$OA$C7
+ }
}
# C8
if(enrichments2do$C8){
- C8set <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C8",
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_C8 <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = C8set
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$C8 ))){
+ C8set <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C8",
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_C8 <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = C8set
+ )
+ res_tmp$OA$C8 <<- EnrichmentRes_C8
+ par_tmp$OA$C8 <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_C8 <- res_tmp$OA$C8
+ }
}
# C2 subset CGP
if(enrichments2do$CGP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CGP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CGP <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CGP ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CGP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CGP <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$CGP <<- EnrichmentRes_CGP
+ par_tmp$OA$CGP <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_CGP <- res_tmp$OA$CGP
+ }
}
# C2 subset CP
if(enrichments2do$CP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CP <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CP ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CP <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$CP <<- EnrichmentRes_CP
+ par_tmp$OA$CP <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_CP <- res_tmp$OA$CP
+ }
}
# C2:CP subset BIOCARTA
if(enrichments2do$BIOCARTA){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:BIOCARTA"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_BIOCARTA <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$BIOCARTA ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:BIOCARTA"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_BIOCARTA <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$BIOCARTA <<- EnrichmentRes_BIOCARTA
+ par_tmp$OA$BIOCARTA <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_BIOCARTA <- res_tmp$OA$BIOCARTA
+ }
}
# C2:CP subset PID
if(enrichments2do$PID){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:PID"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_PID <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$PID ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:PID"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_PID <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$PID <<- EnrichmentRes_PID
+ par_tmp$OA$PID <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_PID <- res_tmp$OA$PID
+ }
}
# C2:CP subset REACTOME
if(enrichments2do$REACTOME){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:REACTOME"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_REACTOME <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$REACTOME ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:REACTOME"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_REACTOME <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$REACTOME <<- EnrichmentRes_REACTOME
+ par_tmp$OA$REACTOME <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_REACTOME <- res_tmp$OA$REACTOME
+ }
}
# C2:CP subset WIKIPATHWAYS
if(enrichments2do$WIKIPATHWAYS){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C2",
- subcategory = "CP:WIKIPATHWAYS"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_WIKIPATHWAYS <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$WIKIPATHWAYS ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C2",
+ subcategory = "CP:WIKIPATHWAYS"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_WIKIPATHWAYS <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$WIKIPATHWAYS <<- EnrichmentRes_WIKIPATHWAYS
+ par_tmp$OA$WIKIPATHWAYS <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_WIKIPATHWAYS <- res_tmp$OA$WIKIPATHWAYS
+ }
}
# C3 subset MIR:MIRDB
if(enrichments2do$MIRDB){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "MIR:MIRDB"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_MIRDB <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$MIRDB ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "MIR:MIRDB"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_MIRDB <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$MIRDB <<- EnrichmentRes_MIRDB
+ par_tmp$OA$MIRDB <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_MIRDB <- res_tmp$OA$MIRDB
+ }
}
# C3 subset MIR:MIR_Legacy
if(enrichments2do$MIR_Legacy){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "MIR:MIR_Legacy"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_MIR_Legacy <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$MIR_Legacy ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "MIR:MIR_Legacy"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_MIR_Legacy <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$MIR_Legacy <<- EnrichmentRes_MIR_Legacy
+ par_tmp$OA$MIR_Legacy <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_MIR_Legacy <- res_tmp$OA$MIR_Legacy
+ }
}
# C3 subset TFT:GTRD
if(enrichments2do$GTRD){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "TFT:GTRD"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GTRD <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GTRD ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "TFT:GTRD"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GTRD <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$GTRD <<- EnrichmentRes_GTRD
+ par_tmp$OA$GTRD <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_GTRD <- res_tmp$OA$GTRD
+ }
}
# C3 subset TFT:TFT_Legacy
if(enrichments2do$TFT_Legacy){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C3",
- subcategory = "TFT:TFT_Legacy"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_TFT_Legacy <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$TFT_Legacy ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C3",
+ subcategory = "TFT:TFT_Legacy"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_TFT_Legacy <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$TFT_Legacy <<- EnrichmentRes_TFT_Legacy
+ par_tmp$OA$TFT_Legacy <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_TFT_Legacy <- res_tmp$OA$TFT_Legacy
+ }
}
# C4 subset CGN
if(enrichments2do$CGN){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- subcategory = "CGN"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CGN <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CGN ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ subcategory = "CGN"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CGN <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$CGN <<- EnrichmentRes_CGN
+ par_tmp$OA$CGN <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_CGN <- res_tmp$OA$CGN
+ }
}
# C4 subset CM
if(enrichments2do$CM){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C4",
- subcategory = "CM"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_CM <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$CM ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C4",
+ subcategory = "CM"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_CM <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$CM <<- EnrichmentRes_CM
+ par_tmp$OA$CM <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_CM <- res_tmp$OA$CM
+ }
}
# C5 subset GO BP
if(enrichments2do$GO_BP){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:BP"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_BP <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_BP ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:BP"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_BP <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$GO_BP <<- EnrichmentRes_GO_BP
+ par_tmp$OA$GO_BP <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_GO_BP <- res_tmp$OA$GO_BP
+ }
}
# C5 subset GO CC
if(enrichments2do$GO_CC){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:CC"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_CC <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_CC ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:CC"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_CC <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$GO_CC <<- EnrichmentRes_GO_CC
+ par_tmp$OA$GO_CC <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_GO_CC <- res_tmp$OA$GO_CC
+ }
}
# C5 subset GO MF
if(enrichments2do$GO_MF){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "GO:MF"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_GO_MF <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$GO_MF ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "GO:MF"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_GO_MF <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$GO_MF <<- EnrichmentRes_GO_MF
+ par_tmp$OA$GO_MF <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_GO_MF <- res_tmp$OA$GO_MF
+ }
}
# C5 subset HPO
if(enrichments2do$HPO){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C5",
- subcategory = "HPO"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_HPO <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$HPO ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C5",
+ subcategory = "HPO"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_HPO <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$HPO <<- EnrichmentRes_HPO
+ par_tmp$OA$HPO <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_HPO <- res_tmp$OA$HPO
+ }
}
# C7 subset IMMUNESIGDB
if(enrichments2do$IMMUNESIGDB){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7",
- subcategory = "IMMUNESIGDB"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_IMMUNESIGDB <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$IMMUNESIGDB ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7",
+ subcategory = "IMMUNESIGDB"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_IMMUNESIGDB <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$IMMUNESIGDB <<- EnrichmentRes_IMMUNESIGDB
+ par_tmp$OA$IMMUNESIGDB <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_IMMUNESIGDB <- res_tmp$OA$IMMUNESIGDB
+ }
}
# C7 subset VAX
if(enrichments2do$VAX){
- genesets4ea <- msigdbr(
- species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
- category = "C7",
- subcategory = "VAX"
- ) %>% dplyr::select(gs_name, entrez_gene)
- EnrichmentRes_VAX <- clusterProfiler::enricher(
- gene = geneSetChoice,
- pvalueCutoff = 0.05,
- pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
- universe = universeSelected_tranlsated,
- TERM2GENE = genesets4ea
- )
+ if(!(identical(list("Universe"=input$UniverseOfGene),par_tmp$OA$VAX ))){
+ genesets4ea <- msigdbr(
+ species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"),
+ category = "C7",
+ subcategory = "VAX"
+ ) %>% dplyr::select(gs_name, entrez_gene)
+ EnrichmentRes_VAX <- clusterProfiler::enricher(
+ gene = geneSetChoice,
+ pvalueCutoff = 0.05,
+ pAdjustMethod = PADJUST_METHOD[[adjustMethod]],
+ universe = universeSelected_tranlsated,
+ TERM2GENE = genesets4ea
+ )
+ res_tmp$OA$VAX <<- EnrichmentRes_VAX
+ par_tmp$OA$VAX <<- list("Universe"=input$UniverseOfGene)
+ }else{
+ EnrichmentRes_VAX <- res_tmp$OA$VAX
+ }
}
return(list(
@@ -498,7 +678,7 @@ over_representation_analysis <- function(
"EnrichmentRes_CGP" = EnrichmentRes_CGP,
"EnrichmentRes_CP" = EnrichmentRes_CP,
"EnrichmentRes_BIOCARTA" = EnrichmentRes_BIOCARTA,
- "EnrichmentRes_KEGG" = EnrichmentRes_Kegg,
+ "EnrichmentRes_KEGG" = EnrichmentRes_KEGG,
"EnrichmentRes_PID" = EnrichmentRes_PID,
"EnrichmentRes_REACTOME" = EnrichmentRes_REACTOME,
"EnrichmentRes_WIKIPATHWAYS" = EnrichmentRes_WIKIPATHWAYS,
diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R
index c2095747..751b5441 100644
--- a/program/shinyApp/R/enrichment_analysis/server.R
+++ b/program/shinyApp/R/enrichment_analysis/server.R
@@ -678,7 +678,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){
ctrl_samples_idx <- which(colData(data$data)[,input$sample_annotation_types_cmp_GSEA] %in% input$Groups2Compare_ref_GSEA)
comparison_samples_idx <- which(colData(data$data)[,input$sample_annotation_types_cmp_GSEA] %in% input$Groups2Compare_treat_GSEA)
- Data2Plot <- getLFC(
+ Data2Plot <- getLFCs(
assays(data$data)$raw,
ctrl_samples_idx,
comparison_samples_idx
@@ -770,11 +770,14 @@ enrichment_analysis_Server <- function(id, data, params, updates){
if(input$ORA_or_GSE == "GeneSetEnrichment"){
ea_reactives$enrichment_results <- gene_set_enrichment(
input,
- output,
ea_reactives$tmp_genes,
data$data,
ea_reactives$enrichments2do,
- input$test_correction
+ input$test_correction,
+ input$sample_annotation_types_cmp_GSEA,
+ input$Groups2Compare_ref_GSEA,
+ input$Groups2Compare_treat_GSEA,
+ input$ValueToAttach
)
}else{
ea_reactives$enrichment_results <- over_representation_analysis(
diff --git a/program/shinyApp/R/enrichment_analysis/ui.R b/program/shinyApp/R/enrichment_analysis/ui.R
index 3e634998..5ebb768d 100644
--- a/program/shinyApp/R/enrichment_analysis/ui.R
+++ b/program/shinyApp/R/enrichment_analysis/ui.R
@@ -20,7 +20,7 @@ geneset_panel_UI <- function(
inputId = ns("only2Report"),
label = "Send only to Report",
class = "btn-info"
- )
+ ) %>% helper(type = "markdown", content = "EA_Download")
),
splitLayout(
style = "border: 1px solid silver:",
@@ -76,14 +76,14 @@ geneset_panel_UI <- function(
ea_sidebar <- function(ns){
sidebarPanel(
id = "sidebar_enrichment_analysis",
- uiOutput(outputId = ns("OrganismChoice_ui")),
+ uiOutput(outputId = ns("OrganismChoice_ui")) %>% helper(type = "markdown", content = "EA_Options"),
uiOutput(outputId = ns("ORA_or_GSE_ui")),
uiOutput(outputId = ns("ValueToAttach_ui")),
uiOutput(outputId = ns("sample_annotation_types_cmp_GSEA_ui")),
uiOutput(outputId = ns("Groups2Compare_ref_GSEA_ui")),
uiOutput(outputId = ns("Groups2Compare_treat_GSEA_ui")),
uiOutput(outputId = ns("psig_threhsold_GSEA_ui")),
- uiOutput(outputId = ns("GeneSetChoice_ui")),
+ uiOutput(outputId = ns("GeneSetChoice_ui")) %>% helper(type = "markdown", content = "EA_GeneSets"),
uiOutput(outputId = ns("AdjustmentMethod_ui")),
uiOutput(outputId = ns("GeneSet2Enrich_ui")),
uiOutput(outputId = ns("UploadedGeneSet_ui")),
diff --git a/program/shinyApp/R/fun_LFC.R b/program/shinyApp/R/fun_LFC.R
index 3b45e8ae..c5ce39b7 100644
--- a/program/shinyApp/R/fun_LFC.R
+++ b/program/shinyApp/R/fun_LFC.R
@@ -1,5 +1,5 @@
# get LFC
-getLFC <- function(
+getLFCs <- function(
data,
ctrl_samples_idx,
comparison_samples_idx,
diff --git a/program/shinyApp/R/fun_volcano.R b/program/shinyApp/R/fun_volcano.R
deleted file mode 100644
index 7f5dcf30..00000000
--- a/program/shinyApp/R/fun_volcano.R
+++ /dev/null
@@ -1,105 +0,0 @@
-# Volcano Function
-Volcano_Plot <- function(
- data,
- ctrl_samples_idx,
- comparison_samples_idx,
- p_sig_threshold,
- LFC_threshold,
- correction_test_method,
- method,
- annotation_add=NULL,
- annoData=NULL,
- alreadyLogged=F
-){
- df <- as.data.frame(data)
- if(method == "T-Test"){
- # TODO test for Varianz Homogenität (Levene Test) -
- # intermediate Lösung könnte sein einfach standard abweichungen der Gruppen anzugeben
- # User hinweisen diese zu untersuchen!
- test_function <- function(...) t.test(..., var.equal = TRUE)
-
- }else if(method == "Welch-Test"){
- test_function <- function(...) t.test(..., var.equal = FALSE)
- }
- else{
- test_function <- wilcox.test
- }
-
- # 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)
- # results$p.value
- # }
-
- ttest_raw <- function(df, grp1, grp2) {
- x <- df[grp1]
- y <- df[grp2]
- x <- as.numeric(x)
- y <- as.numeric(y)
- tryCatch(
- {
- results <- test_function(x, y)
- return(results$p.value)
- },
- error = function(e) {
- cat(
- "Error in gene ", df["gene"], ":\n ",
- as.character(e), " Values are:\n",
- " x: ", paste(x),
- "\n y: ", paste(y), "\n",
- "NA will be returned instead. \n",
- sep = ""
- )
- return(NA)
- }
- )
- }
- #remove constant rows for control and comparisons separately
- df <- df[(apply(df[,ctrl_samples_idx], 1, sd) > 0),]
- df <- df[(apply(df[,comparison_samples_idx], 1, sd) > 0),]
-
- print(paste0("Number of rows removed due to being group-wise constant: ",dim(as.data.frame(data))[1]-dim(df)[1]))
-
- rawpvalue <- apply(
- df, 1, ttest_raw, grp1 = ctrl_samples_idx, grp2 = comparison_samples_idx
- )
-
- p_adj <- p.adjust(rawpvalue, method = PADJUST_METHOD[[correction_test_method]])
-
- Ctrl_mean <- apply(df[,ctrl_samples_idx],1,mean)
- # check whether there are 0's in Ctrl mean
- if(any(Ctrl_mean < 0)){
- warning("NAs will be produced due to impossible division by 0")
- }
-
- Cmp_mean <- apply(df[,comparison_samples_idx], 1, mean)
-
- FC <- Cmp_mean/Ctrl_mean
-
-
- if(alreadyLogged){
- LFC <- FC
- }else{
- LFC <- log2(FC)
- }
-
- # Data 2 Plot
- results <- cbind(LFC, rawpvalue,p_adj)
- results <- as.data.frame(results)
- results$probename <- rownames(results)
- results$threshold <- ifelse(results$p_adj>p_sig_threshold,"non-significant","significant")
- results$threshold_fc <- ifelse(results$LFC>LFC_threshold|results$LFC<(-LFC_threshold),"change"," ")
- results$combined <- paste0(results$threshold,"_",results$threshold_fc)
- colorScheme <- c("#cf0e5b","#939596")
- names(colorScheme) <- c("significant","non-significant")
- alphaScheme <- c(0.8,0.1)
- names(alphaScheme) <- c("change","steady")
-
- # add annotation data based on user Input (ergo annotation_add)
- results$annotation_add <- annoData[rownames(results),annotation_add]
-
- return(results)
-}
\ No newline at end of file
diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R
index 8a0518be..82126387 100644
--- a/program/shinyApp/R/heatmap/server.R
+++ b/program/shinyApp/R/heatmap/server.R
@@ -224,8 +224,7 @@ heatmap_server <- function(id, data, params, updates){
print("Heatmap on selected Data")
# Value need to be setted in case there is nothing to plot to avoid crash
scenario <- 0
- ### atm raw data plotted
- data2Plot <- data$data
+
colorTheme <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c",
"#fdbf6f", "#ff7f00", "#fb9a99", "#e31a1c")
customTitleHeatmap <- paste0(
@@ -238,6 +237,9 @@ heatmap_server <- function(id, data, params, updates){
input$PreProcessing_Procedure
)
+ ### atm raw data plotted
+ data2Plot <- data$data
+
print(customTitleHeatmap)
mycolors <- list()
if(length(input$anno_options) == 1){
@@ -252,7 +254,6 @@ heatmap_server <- function(id, data, params, updates){
myColor_fill <- colorRampPalette(c("blue", "white", "firebrick"))(paletteLength)
##### Do PreSelection of input to Heatmap to show
- #
print(input$row_selection_options)
# selection based on row Annotation:
if(!(any(input$row_selection_options == "all"))){
@@ -262,7 +263,6 @@ heatmap_server <- function(id, data, params, updates){
# additionalInput_row_anno="all"
# additionalInput_row_anno_factor=NA
# }else{
- print("We should be here")
print(input$row_anno_options_heatmap)
additionalInput_row_anno <- ifelse(any(input$row_selection_options == "rowAnno_based"),"yip",NA)
if(!is.na(additionalInput_row_anno)){
@@ -270,7 +270,7 @@ heatmap_server <- function(id, data, params, updates){
print(additionalInput_row_anno)
}
additionalInput_row_anno_factor <- input$row_anno_options_heatmap
- #} # check if this is working if yes delete lines
+ #} # check if this is working if yes delete lines # @leaseep, is this checked
}else{
additionalInput_row_anno <- ifelse(any(input$row_selection_options == "rowAnno_based"),input$anno_options_heatmap,NA)
additionalInput_row_anno_factor <- ifelse(any(input$row_selection_options == "rowAnno_based"),c(input$row_anno_options_heatmap),NA)
@@ -327,97 +327,184 @@ heatmap_server <- function(id, data, params, updates){
}
print(paste0("plot LFC's?",input$LFC_toHeatmap))
- # Dependent to plot raw data or LFC
- if(input$LFC_toHeatmap){
- ctrl_samples_idx <- which(
- colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_ref_heatmap
- )
- comparison_samples_idx <- which(
- colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_treat_heatmap
- )
- if(length(comparison_samples_idx) <=1 |
- length(ctrl_samples_idx)<=1){
- output$Options_selected_out_3 <- renderText("Choose variable with at least two samples per condition!")
- doThis_flag <- F
- }
- if(input$PreProcessing_Procedure == "simpleCenterScaling"|
- any(assay(data$data))< 0){
- # TODO: there must be a nicer way to do this then as.data.frame(assay(data$data))
- print("Remember do not use normal center + scaling (negative Values!)")
- output$Options_selected_out_3 <- renderText("Choose another preprocessing, as there are negative values!")
+ # Dependent to plot raw data or LFC if calculation is needed
+ calculate <- 1
+ # check whether we have to calculate
+ check <- check_calculations(list(
+ anno_options = input$anno_options,
+ row_anno_options = input$row_anno_options,
+ row_label_options = input$row_label_options,
+ cluster_rows = input$cluster_rows,
+ cluster_cols = input$cluster_cols,
+ LFCToHeatmap = input$LFC_toHeatmap, # decider for scenario
+ row_selection_options = input$row_selection_options,
+ rowWiseScaled = input$rowWiseScaled,
+ sample_annotation_types_cmp_heatmap = input$sample_annotation_types_cmp_heatmap,
+ Groups2Compare_ref_heatmap = input$Groups2Compare_ref_heatmap,
+ Groups2Compare_ctrl_heatmap = input$Groups2Compare_ctrl_heatmap,
+ anno_options_heatmap = input$anno_options_heatmap,
+ row_anno_options_heatmap = input$row_anno_options_heatmap), "Heatmap")
+ if (check == "No Result yet"){
+ output$Heatmap_Info <- renderText("Heatmap computed.")
+ } else if (check == "Result exists"){
+ output$Heatmap_Info <- renderText(
+ "Heatmap was already computed, no need to click the Button again."
+ )
+ calculate <- 0
+ } else if (check == "Overwrite"){
+ output$Heatmap_Info <- renderText(
+ "Heatmap overwritten with different parameters."
+ )
+ }
+ if(calculate == 1){
+ if(input$LFC_toHeatmap){
+ ctrl_samples_idx <- which(
+ colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_ref_heatmap
+ )
+ comparison_samples_idx <- which(
+ colData(data$data)[,input$sample_annotation_types_cmp_heatmap]%in%input$Groups2Compare_treat_heatmap
+ )
+ if(length(comparison_samples_idx) <=1 |
+ length(ctrl_samples_idx)<=1){
+ output$Options_selected_out_3 <- renderText("Choose variable with at least two samples per condition!")
+ doThis_flag <- F
+ }
+ if(input$PreProcessing_Procedure == "simpleCenterScaling"|
+ any(assay(data$data))< 0){
+ # TODO: there must be a nicer way to do this then as.data.frame(assay(data$data))
+ print("Remember do not use normal center + scaling (negative Values!)")
+ output$Options_selected_out_3 <- renderText("Choose another preprocessing, as there are negative values!")
- }else if(doThis_flag){
- print(dim(selectedData_processed()[[omicType()]]$Matrix))
- Data2Plot <- getLFC(
- data = as.data.frame(assay(data$data)),
- ctrl_samples_idx = ctrl_samples_idx,
- comparison_samples_idx = comparison_samples_idx
+ }else if(doThis_flag){
+ print(dim(selectedData_processed()[[omicType()]]$Matrix))
+ Data2Plot <- getLFC(
+ data = as.data.frame(assay(data$data)),
+ ctrl_samples_idx = ctrl_samples_idx,
+ comparison_samples_idx = comparison_samples_idx
+ )
+
+ ## do pheatmap
+ #remove anything non sig
+ Data2Plot <- Data2Plot[Data2Plot$p_adj<0.05,]
+ # use floor and ceiling to deal with even/odd length pallettelengths
+ myBreaks <- c(seq(min(Data2Plot$LFC), 0, length.out=ceiling(paletteLength/2) + 1),
+ seq(max(Data2Plot$LFC)/paletteLength, max(Data2Plot$LFC), length.out=floor(paletteLength/2)))
+
+ scenario <- 10
+ annotation_col <- rowData(data2Plot)[,input$row_anno_options,drop=F]
+ heatmap_plot <- pheatmap(
+ t(Data2Plot[,"LFC",drop=F]),
+ main = gsub("^Heatmap","Heatmap_LFC",customTitleHeatmap),
+ show_rownames = ifelse(nrow(Data2Plot)<=25,TRUE,FALSE),
+ show_colnames = TRUE,
+ cluster_cols = input$cluster_cols,
+ cluster_rows = FALSE,
+ scale=ifelse(input$rowWiseScaled,"row","none"),
+ annotation_col = annotation_col,
+ silent = F,
+ breaks = myBreaks,
+ color = myColor_fill
)
-
- ## do pheatmap
- #remove anything non sig
- Data2Plot <- Data2Plot[Data2Plot$p_adj<0.05,]
- # use floor and ceiling to deal with even/odd length pallettelengths
- myBreaks <- c(seq(min(Data2Plot$LFC), 0, length.out=ceiling(paletteLength/2) + 1),
- seq(max(Data2Plot$LFC)/paletteLength, max(Data2Plot$LFC), length.out=floor(paletteLength/2)))
-
- scenario <- 10
- annotation_col <- rowData(data2Plot)[,input$row_anno_options,drop=F]
+ }
+ }else if(doThis_flag){
+ if(any(is.na(data2HandOver))){
+ idx_of_nas <- which(apply(data2HandOver,1,is.na)) # why do we produce Nas?
+ print(idx_of_nas)
+ if(length(idx_of_nas)>0){
+ data2HandOver <- data2HandOver[-idx_of_nas,]
+ }
+
+ annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F]
+ annotation_row <- rowData(data$data)[-idx_of_nas,input$row_anno_options,drop=F]
+ # convert both to data.frame
+ annotation_col <- as.data.frame(annotation_col)
+ annotation_row <- as.data.frame(annotation_row)
+ }else{
+ annotation_col <- colData(data$data)[,input$anno_options,drop=F]
+ annotation_row <- rowData(data$data)[,input$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(data2HandOver))>1,input$cluster_rows,F)
+ print(input$anno_options)
+ print(input$row_label_options)
+ #row_label_options
+ scenario <- 11
heatmap_plot <- pheatmap(
- t(Data2Plot[,"LFC",drop=F]),
- main = gsub("^Heatmap","Heatmap_LFC",customTitleHeatmap),
- show_rownames = ifelse(nrow(Data2Plot)<=25,TRUE,FALSE),
+ as.matrix(data2HandOver),
+ main = customTitleHeatmap,
+ show_rownames = ifelse(nrow(data2HandOver)<=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,
- cluster_rows = FALSE,
+ cluster_rows = clusterRowspossible,
scale=ifelse(input$rowWiseScaled,"row","none"),
annotation_col = annotation_col,
- silent = F,
- breaks = myBreaks,
- color = myColor_fill
+ annotation_row = annotation_row,
+ annotation_colors = mycolors,
+ silent = F
)
}
- }else if(doThis_flag){
- if(any(is.na(data2HandOver))){
- idx_of_nas <- which(apply(data2HandOver,1,is.na)) # why do we produce Nas?
- print(idx_of_nas)
- if(length(idx_of_nas)>0){
- data2HandOver <- data2HandOver[-idx_of_nas,]
- }
+ } 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)))
+ annotation_col <- rowData(data2Plot)[,input$row_anno_options,drop=F]
- annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F]
- annotation_row <- rowData(data$data)[-idx_of_nas,input$row_anno_options,drop=F]
- # convert both to data.frame
- annotation_col <- as.data.frame(annotation_col)
- annotation_row <- as.data.frame(annotation_row)
- }else{
- annotation_col <- colData(data$data)[,input$anno_options,drop=F]
- annotation_row <- rowData(data$data)[,input$row_anno_options,drop=F]
- # convert both to data.frame
- annotation_col <- as.data.frame(annotation_col)
- annotation_row <- as.data.frame(annotation_row)
+ scenario <- 10
+ heatmap_plot <- pheatmap(
+ t(res_tmp$Heatmap[,"LFC",drop=F]),
+ main = gsub("^Heatmap","Heatmap_LFC",customTitleHeatmap),
+ show_rownames = ifelse(nrow(res_tmp$Heatmap)<=25,TRUE,FALSE),
+ show_colnames = TRUE,
+ cluster_cols = input$cluster_cols,
+ cluster_rows = FALSE,
+ scale=ifelse(input$rowWiseScaled,"row","none"),
+ annotation_col = annotation_col,
+ silent = F,
+ breaks = myBreaks,
+ 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?
+ print(idx_of_nas)
+ if(length(idx_of_nas)>0){
+ res_tmp$Heatmap <- res_tmp$Heatmap[-idx_of_nas,]
+ }
+
+ annotation_col <- colData(data$data)[-idx_of_nas,input$anno_options,drop=F]
+ annotation_row <- rowData(data$data)[-idx_of_nas,input$row_anno_options,drop=F]
+ # convert both to data.frame
+ annotation_col <- as.data.frame(annotation_col)
+ annotation_row <- as.data.frame(annotation_row)
+ }else{
+ annotation_col <- colData(data$data)[,input$anno_options,drop=F]
+ annotation_row <- rowData(data$data)[,input$row_anno_options,drop=F]
+ # convert both to data.frame
+ annotation_col <- as.data.frame(annotation_col)
+ annotation_row <- as.data.frame(annotation_row)
+ }
+ scenario <- 11
+ heatmap_plot <- pheatmap(
+ as.matrix(res_tmp$Heatmap),
+ main = customTitleHeatmap,
+ show_rownames = ifelse(nrow(res_tmp$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,
+ cluster_rows = clusterRowspossible,
+ scale=ifelse(input$rowWiseScaled,"row","none"),
+ annotation_col = annotation_col,
+ annotation_row = annotation_row,
+ annotation_colors = mycolors,
+ silent = F
+ )
}
- clusterRowspossible <- ifelse(nrow(as.matrix(data2HandOver))>1,input$cluster_rows,F)
- print(input$anno_options)
- print(input$row_label_options)
- #row_label_options
- scenario <- 11
- heatmap_plot<-pheatmap(
- as.matrix(data2HandOver),
- main = customTitleHeatmap,
- show_rownames = ifelse(nrow(data2HandOver)<=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,
- cluster_rows = clusterRowspossible,
- scale=ifelse(input$rowWiseScaled,"row","none"),
- annotation_col = annotation_col,
- annotation_row = annotation_row,
- annotation_colors = mycolors,
- silent = F
- )
}
-
heatmap_scenario <- scenario
output[["HeatmapPlot"]] <- renderPlot({heatmap_plot})
@@ -440,9 +527,9 @@ heatmap_server <- function(id, data, params, updates){
# res_tmp gets data2HandOver or Data2Plot depending on scenario
if(scenario == 10){
- res_tmp["Heatmap"] <<- Data2Plot
+ res_tmp[["Heatmap"]] <<- Data2Plot
}else if(scenario == 11){
- res_tmp["Heatmap"] <<- data2HandOver
+ res_tmp[["Heatmap"]] <<- data2HandOver
}
# par_tmp gets the parameters used for the heatmap
par_tmp[["Heatmap"]] <<- list(
@@ -451,13 +538,12 @@ heatmap_server <- function(id, data, params, updates){
row_label_options = input$row_label_options,
cluster_rows = input$cluster_rows,
cluster_cols = input$cluster_cols,
- LFCToHeatmap = input$LFC_toHeatmap,
+ LFCToHeatmap = input$LFC_toHeatmap, # decider for scenario
row_selection_options = input$row_selection_options,
rowWiseScaled = input$rowWiseScaled,
sample_annotation_types_cmp_heatmap = input$sample_annotation_types_cmp_heatmap,
Groups2Compare_ref_heatmap = input$Groups2Compare_ref_heatmap,
Groups2Compare_ctrl_heatmap = input$Groups2Compare_ctrl_heatmap,
- TopK = input$TopK,
anno_options_heatmap = input$anno_options_heatmap,
row_anno_options_heatmap = input$row_anno_options_heatmap
)
diff --git a/program/shinyApp/R/heatmap/ui.R b/program/shinyApp/R/heatmap/ui.R
index 18e8fcc4..3c2d24a5 100644
--- a/program/shinyApp/R/heatmap/ui.R
+++ b/program/shinyApp/R/heatmap/ui.R
@@ -4,9 +4,9 @@ heatmap_sidebar<- function(ns){
#########################################
# Heatmap
#########################################
- uiOutput(outputId = ns("row_selection_options_ui")),
+ uiOutput(outputId = ns("row_selection_options_ui")) %>% helper(type = "markdown", content = "Heatmap_Options"),
uiOutput(outputId = ns("LFC_toHeatmap_ui")),
- h5("Further row selection (LFC based)"),
+ h5("Further row selection (LFC based)") %>% helper(type = "markdown", content = "Heatmap_FurtherOptions"),
uiOutput(outputId = ns("TopK_ui")),
switchInput(
inputId = ns("Selection_show_LFC"),
@@ -24,7 +24,7 @@ heatmap_sidebar<- function(ns){
icon(name = "fas fa-laptop-code")
),
hr(style = "border-top: 1px solid #000000;"),
- h5("Aesthetics"),
+ h5("Aesthetics") %>% helper(type = "markdown", content = "Heatmap_Aesthetics"),
switchInput(
inputId = ns("Aesthetics_show"),
label = "show options",
@@ -37,7 +37,7 @@ heatmap_sidebar<- function(ns){
uiOutput(outputId = ns("cluster_cols_ui")),
uiOutput(outputId = ns("cluster_rows_ui")),
hr(style = "border-top: 1px solid #858585;"),
- h5("Further row selection (annotation based)"),
+ h5("Further row selection (annotation based)") %>% helper(type = "markdown", content = "Heatmap_RowAnnoBased"),
helpText("Note: This only shows options if 'rowAnno_based' is selected for 'Row selection' (top of the sidebar)"),
switchInput(
inputId = ns("Selection_show_annoBased"),
@@ -56,6 +56,7 @@ heatmap_sidebar<- function(ns){
heatmap_main <- function(ns){
mainPanel(
id = "main_heatmap",
+ textOutput(outputId = ns("Heatmap_Info"), container = pre),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("100%"),
plotOutput(
@@ -82,7 +83,7 @@ heatmap_main <- function(ns){
inputId = ns("only2Report_Heatmap"),
label = "Send only to Report",
class = "btn-info"
- ),
+ ) %>% helper(type = "markdown", content = "Heatmap_Download"),
),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("70%", "30%"),
diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R
index f32fa2bf..bf38b017 100644
--- a/program/shinyApp/R/pca/server.R
+++ b/program/shinyApp/R/pca/server.R
@@ -146,7 +146,25 @@ pca_Server <- function(id, data, params, row_select, updates){
session$userData$clicks_observer <- observeEvent(input$Do_PCA,{
req(input$Do_PCA > pca_reactives$counter)
pca_reactives$counter <- input$Do_PCA
- pca_reactives$calculate <- 1
+ check <- check_calculations(list(
+ dummy = "dummy",
+ sample_selection_pca = input$sample_selection_pca,
+ SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca
+ ), "PCA")
+ if (check == "No Result yet"){
+ output$PCA_Info <- renderText("PCA computed.")
+ pca_reactives$calculate <- 1
+ } else if (check == "Result exists"){
+ output$PCA_Info <- renderText(
+ "PCA was already computed, no need to click the Button again."
+ )
+ pca_reactives$calculate <- -1
+ } else if (check == "Overwrite"){
+ output$PCA_Info <- renderText(
+ "PCA result overwritten with different parameters."
+ )
+ pca_reactives$calculate <- 1
+ }
})
observeEvent(toListen2PCA(),{
@@ -166,7 +184,7 @@ pca_Server <- function(id, data, params, row_select, updates){
input$PreProcessing_Procedure
)
print(customTitle)
- # only calculate PCA, Scrre and Loadings if the counter is 1
+ # only calculate PCA, Score and Loadings if the counter is >= 0
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
@@ -180,8 +198,8 @@ pca_Server <- function(id, data, params, row_select, updates){
)
}
pca_reactives$current_updates <- updates()
- # set the counter to 0 to prevent any further plotting
- pca_reactives$calculate <- 0
+ # set the counter to -1 to prevent any further plotting
+ pca_reactives$calculate <- -1
print("Calculate PCA")
# PCA
pca <- prcomp(
@@ -300,12 +318,16 @@ pca_Server <- function(id, data, params, row_select, updates){
pca_reactives$var_explained_df <- var_explained_df
pca_reactives$LoadingsDF <- LoadingsDF
pca_reactives$df_loadings <- df_loadings
+
# assign res_temp
- res_tmp["PCA"] <<- list(pca)
+ res_tmp[["PCA"]] <<- list(pca)
# assign par_temp as empty list
- par_tmp["PCA"] <<- list(
+ par_tmp[["PCA"]] <<- list(
# add a dummy parameter to avoid error
- dummy = "dummy"
+ dummy = "dummy",
+ sample_selection_pca = input$sample_selection_pca,
+ SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca
+
)
} else {
# otherwise read the reactive values
diff --git a/program/shinyApp/R/pca/ui.R b/program/shinyApp/R/pca/ui.R
index e39844c0..36b9a983 100644
--- a/program/shinyApp/R/pca/ui.R
+++ b/program/shinyApp/R/pca/ui.R
@@ -5,7 +5,7 @@ pca_sidebar_panel <- function(ns){
# explorative analysis
# PCA
#########################################
- h4("Explorative Analysis"),
+ h4("Explorative Analysis") %>% helper(type = "markdown", content = "PCA_Choices"),
### data selection
switchInput(
inputId = ns("data_selection_pca"),
@@ -40,11 +40,8 @@ pca_main_panel <- function(ns){
type = "pills",
tabPanel(
title = "PCA_plot",
- splitLayout(
- style = "border: 1px solid silver:", cellWidths = c("70%", "30%"),
- plotlyOutput(outputId = ns("PCA_plot")) ,
- textOutput(outputId = ns("PCA_plot_Options_selected"), container = pre)
- ),
+ textOutput(outputId = ns("PCA_Info"), container = pre),
+ plotlyOutput(outputId = ns("PCA_plot")),
uiOutput(outputId = ns("PCA_anno_tooltip_ui")),
splitLayout(
style = "border: 1px solid silver:",
@@ -53,7 +50,7 @@ pca_main_panel <- function(ns){
actionButton(
inputId = ns("only2Report_pca"),
label = "Send only to Report"
- )
+ ) %>% helper(type = "markdown", content = "PCA_Downloads")
),
splitLayout(
style = "border: 1px solid silver:",
@@ -127,7 +124,7 @@ pca_main_panel <- function(ns){
inputId = ns("only2Report_Loadings"),
label = "Send only to Report",
class = "btn-info"
- )
+ ) %>% helper(type = "markdown", content = "PCA_LoadingsDownload")
),
splitLayout(
style = "border: 1px solid silver:",
@@ -189,7 +186,7 @@ pca_main_panel <- function(ns){
inputId = ns("only2Report_Loadings_matrix"),
label = "Send only to Report",
class = "btn-info"
- )
+ ) %>% helper(type = "markdown", content = "PCA_LoadingsMatrixDownload")
),
splitLayout(
style = "border: 1px solid silver:",
@@ -239,7 +236,7 @@ pca_main_panel <- function(ns){
inputId = ns("only2Report_Scree_Plot"),
label = "Send only to Report",
class = "btn-info"
- )
+ ) %>% helper(type = "markdown", content = "PCA_ScreeDownload")
),
splitLayout(
style = "border: 1px solid silver:",
@@ -272,7 +269,7 @@ pca_main_panel <- function(ns){
selected = ".png"
)
)
- )
+ ) # %>% helper(type = "markdown", content = "PCA_Tabpanels")
)
)
}
diff --git a/program/shinyApp/R/pca/util.R b/program/shinyApp/R/pca/util.R
new file mode 100644
index 00000000..26bd3c60
--- /dev/null
+++ b/program/shinyApp/R/pca/util.R
@@ -0,0 +1,12 @@
+check_calculations <- function(current_parameters, module){
+ if (is.null(res_tmp[[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)){
+ return("Result exists")
+ }
+ # The remaining case is an existing result with other parameters,
+ # which will trigger an alert
+ return("Overwrite")
+}
\ No newline at end of file
diff --git a/program/shinyApp/R/pre_processing/ui.R b/program/shinyApp/R/pre_processing/ui.R
index b712fd57..44e0ad15 100644
--- a/program/shinyApp/R/pre_processing/ui.R
+++ b/program/shinyApp/R/pre_processing/ui.R
@@ -3,7 +3,7 @@ pre_processing_sidebar_panel <- sidebarPanel(
#########################################
# Do Center & scaling + potential other pre-processing stuff
#########################################
- h5("Pre-Processing Procedures"), # this could be enhanced with personalized procedures
+ # this could be enhanced with personalized procedures
radioButtons(
inputId = "PreProcessing_Procedure",
label = "Pre-Processing Procedures",
@@ -12,9 +12,9 @@ pre_processing_sidebar_panel <- sidebarPanel(
"log10", "pareto_scaling", "ln"
),
selected = "none"
- ),
- uiOutput(outputId = "DESeq_formula_main_ui"),
- uiOutput(outputId = "DESeq_formula_sub_ui"),
+ ) %>% helper(type = "markdown", content = "PreProcessing_Procedures"),
+ uiOutput(outputId = "DESeq_formula_main_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqMain"),
+ uiOutput(outputId = "DESeq_formula_sub_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqSub"),
switchInput(
inputId = "DESeq_show_advanced",
label = "Advanced formula options for DESeq2",
diff --git a/program/shinyApp/R/sample_correlation/server.R b/program/shinyApp/R/sample_correlation/server.R
index 6f3619f7..da142eb0 100644
--- a/program/shinyApp/R/sample_correlation/server.R
+++ b/program/shinyApp/R/sample_correlation/server.R
@@ -45,76 +45,98 @@ sample_correlation_server <- function(id, data, params, updates){
# set the counter to 0 to prevent any further plotting
sample_corr_reactive$calculate <- 0
- # check value of input$Do_SampleCorrelation
- annotationDF <- colData(data$data)[,input$SampleAnnotationChoice,drop = F]
- cormat <- cor(
- x = as.matrix(assay(data$data)),
- method = input$corrMethod
+ # check value of input$Do_SampleCorrelation
+ annotationDF <- colData(data$data)[,input$SampleAnnotationChoice,drop = F]
+ check <- check_calculations(
+ list(corrMethod = input$corrMethod),
+ "SampleCorrelation"
)
-
- customTitleSampleCorrelation <- paste0(
- "Sample Correlation - ",
- params$omic_type,"-",
- paste0("entities:",params$row_selection,collapse = "_"),
- "-samples",
- ifelse(any(params$row_selection != "all"),paste0(" (with: ",paste0(params$row_selection,collapse = ", "),")"),""),
- "-preprocessing: ",
- params$PreProcessing_Procedure
- )
-
- # more advanced colors
- # Identify how many anno colors it is asked for (max 3 atm)
- # check the levels if more than 8 go for rainbow
- # more divergent palletes
- palletteOrder <- c("Paired","Pastel2","Dark2")
- anno_colors <- list()
- for (i in 1:(ncol(annotationDF))) {
- if (i > 3) {
- break
+ if (check == "No Result yet"){
+ output$SampleCorr_Info <- renderText(
+ "Correlation Matrix successfully computed."
+ )
+ cormat <- cor(
+ x = as.matrix(assay(data$data)),
+ method = input$corrMethod
+ )
+ } else if (check == "Result exists"){
+ output$SampleCorr_Info <- renderText(
+ "Correlation Matrix was already computed, no need to click the Button again."
+ )
+ cormat <- res_tmp$SampleCorrelation
+ } else if (check == "Overwrite"){
+ output$SampleCorr_Info <- renderText(
+ "Correlation Matrix result overwritten with different parameters."
+ )
+ cormat <- cor(
+ x = as.matrix(assay(data$data)),
+ method = input$corrMethod
+ )
}
- if (length(unique(annotationDF[,i])) == 2){
- colors_tmp <- c("navy","orange")
- names(colors_tmp) <- unique(annotationDF[,i])
- anno_colors[[colnames(annotationDF)[i]]] <- colors_tmp
- }else if (length(unique(annotationDF[,i])) <= 8) {
- colors_tmp <- RColorBrewer::brewer.pal(
- n = length(unique(annotationDF[,i])),
- name = palletteOrder[i]
- )
- names(colors_tmp) <- unique(annotationDF[,i])
- anno_colors[[colnames(annotationDF)[i]]] <- colors_tmp
+
+ customTitleSampleCorrelation <- paste0(
+ "Sample Correlation - ",
+ params$omic_type,"-",
+ paste0("entities:",params$row_selection,collapse = "_"),
+ "-samples",
+ ifelse(any(params$row_selection != "all"),paste0(" (with: ",paste0(params$row_selection,collapse = ", "),")"),""),
+ "-preprocessing: ",
+ params$PreProcessing_Procedure
+ )
+
+ # more advanced colors
+ # Identify how many anno colors it is asked for (max 3 atm)
+ # check the levels if more than 8 go for rainbow
+ # more divergent palletes
+ palletteOrder <- c("Paired","Pastel2","Dark2")
+ anno_colors <- list()
+ for (i in 1:(ncol(annotationDF))) {
+ if (i > 3) {
+ break
+ }
+ if (length(unique(annotationDF[,i])) == 2){
+ colors_tmp <- c("navy","orange")
+ names(colors_tmp) <- unique(annotationDF[,i])
+ anno_colors[[colnames(annotationDF)[i]]] <- colors_tmp
+ }else if (length(unique(annotationDF[,i])) <= 8) {
+ colors_tmp <- RColorBrewer::brewer.pal(
+ n = length(unique(annotationDF[,i])),
+ name = palletteOrder[i]
+ )
+ names(colors_tmp) <- unique(annotationDF[,i])
+ anno_colors[[colnames(annotationDF)[i]]] <- colors_tmp
+ }
}
- }
- SampleCorrelationPlot_final <- pheatmap(
- mat = cormat,
- annotation_row = as.data.frame(annotationDF),
- main = customTitleSampleCorrelation,
- annotation_colors = anno_colors
+ SampleCorrelationPlot_final <- pheatmap(
+ mat = cormat,
+ annotation_row = as.data.frame(annotationDF),
+ main = customTitleSampleCorrelation,
+ annotation_colors = anno_colors
+ )
+ # assign res_temp["SampleCorrelation"]
+ res_tmp[["SampleCorrelation"]] <<- cormat
+ # assign par_temp["SampleCorrelation"]
+ par_tmp[["SampleCorrelation"]] <<- list(
+ corrMethod = input$corrMethod
+ )
+
+ sampleCorrelation_scenario <- 18
+ output$SampleCorrelationPlot <- renderPlot({SampleCorrelationPlot_final})
+
+ # Longer names causes issues for saving
+ if(nchar(customTitleSampleCorrelation) >= 250){
+ customTitleSampleCorrelation <- "SampleCorrelation"
+ }
+
+ par_tmp[["SampleCorr"]] <<- list(
+ customTitleSampleCorrelation = customTitleSampleCorrelation,
+ SampleCorrelationPlot_final = SampleCorrelationPlot_final,
+ cormat = cormat,
+ annotationDF = annotationDF,
+ anno_colors = anno_colors,
+ sampleCorrelation_scenario = sampleCorrelation_scenario
)
- # assign res_temp["SampleCorrelation"]
- res_tmp[["SampleCorrelation"]] <<- cormat
- # assign par_temp["SampleCorrelation"]
- par_tmp["SampleCorrelation"] <<- list(
- corrMethod = input$corrMethod
- )
-
- sampleCorrelation_scenario <- 18
- output$SampleCorrelationPlot <- renderPlot({SampleCorrelationPlot_final})
-
- # Longer names causes issues for saving
- if(nchar(customTitleSampleCorrelation) >= 250){
- customTitleSampleCorrelation <- "SampleCorrelation"
- }
-
- par_tmp[["SampleCorr"]] <<- list(
- customTitleSampleCorrelation = customTitleSampleCorrelation,
- SampleCorrelationPlot_final = SampleCorrelationPlot_final,
- cormat = cormat,
- annotationDF = annotationDF,
- anno_colors = anno_colors,
- sampleCorrelation_scenario = sampleCorrelation_scenario
- )
}
})
diff --git a/program/shinyApp/R/sample_correlation/ui.R b/program/shinyApp/R/sample_correlation/ui.R
index 4868648f..9683f905 100644
--- a/program/shinyApp/R/sample_correlation/ui.R
+++ b/program/shinyApp/R/sample_correlation/ui.R
@@ -1,7 +1,7 @@
sampleCorrelation_sidebar_panel <- function(ns){
sidebarPanel(
id = "sidebar_sampleCorrelation",
- h4("Sample Correlation"),
+ h4("Sample Correlation") %>% helper(type = "markdown", content = "SampleCorr_Choices"),
selectInput(
inputId = ns("corrMethod"),
label = "Choose the correlation method",
@@ -22,6 +22,7 @@ sampleCorrelation_sidebar_panel <- function(ns){
sampleCorrelation_main_panel <- function(ns){
mainPanel(
id = "main_sampleCorrelation",
+ textOutput(outputId = ns("SampleCorr_Info"), container = pre),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("100%"),
plotOutput(
@@ -37,7 +38,7 @@ sampleCorrelation_main_panel <- function(ns){
inputId = ns("only2Report_SampleCorrelation"),
label = "Send only to Report",
class = "btn-info"
- ),
+ ) %>% helper(type = "markdown", content = "SampleCorr_Downloads"),
),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("70%", "30%"),
diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R
index 557d94a5..8a72aad8 100644
--- a/program/shinyApp/R/significance_analysis/server.R
+++ b/program/shinyApp/R/significance_analysis/server.R
@@ -223,9 +223,18 @@ significance_analysis_server <- function(id, data, params, updates){
for (i in 1:length(newList)) {
contrasts[[i]] <- unlist(strsplit(x = input$comparisons[i],split = ":"))
}
+
# get the results for each contrast and put it all in a big results object
sig_results <<- list()
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]]]
+ )){
+ print("Results exists, skipping calculations.")
+ sig_results[[input$comparisons[i]]] <<- res_tmp$SigAna[[input$sample_annotation_types_cmp]][[input$comparisons[i]]]
+ next
+ }
sig_results[[input$comparisons[i]]] <<- DESeq2::results(
dds,
contrast = c(
@@ -235,6 +244,12 @@ 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(
+ test_method = "Wald",
+ test_correction = PADJUST_METHOD[[input$test_correction]]
+ )
### put in here browser if use of `script_getSigToExcel`
}
}
@@ -335,28 +350,16 @@ significance_analysis_server <- function(id, data, params, updates){
chosenVizSet <- input$comparisons_to_visualize
}
for (i in 1:length(chosenVizSet)) {
- if(params$PreProcessing_Procedure == "vst_DESeq"){
- to_add_tmp <- rownames(
- filter_significant_result(
- result = sig_results[[chosenVizSet[i]]],
- alpha = input$significance_level,
- filter_type = input$sig_to_look_at
- )
- )
- # only add if the result is not empty
- if(length(to_add_tmp) > 0){
- res2plot[[chosenVizSet[i]]] <- to_add_tmp
- }
- }else{
- to_add_tmp <- filter_significant_result(
+ to_add_tmp <- rownames(
+ filter_significant_result(
result = sig_results[[chosenVizSet[i]]],
alpha = input$significance_level,
filter_type = input$sig_to_look_at
- )$gene
- # only add if the result is not empty
- if(length(to_add_tmp) > 0){
- res2plot[[chosenVizSet[i]]] <- to_add_tmp
- }
+ )
+ )
+ # only add if the result is not empty
+ if(length(to_add_tmp) > 0){
+ res2plot[[chosenVizSet[i]]] <- to_add_tmp
}
}
# check that you have more than one comparison
@@ -373,6 +376,7 @@ significance_analysis_server <- function(id, data, params, updates){
output$Significant_Plot_final <- renderPlot({})
return(NULL)
}
+
# plot the results
if(input$visualization_method == "UpSetR plot"){
sig_ana_reactive$overlap_list <- prepare_upset_plot(res2plot=res2plot)
diff --git a/program/shinyApp/R/significance_analysis/ui.R b/program/shinyApp/R/significance_analysis/ui.R
index 2f7d4a39..2289d247 100644
--- a/program/shinyApp/R/significance_analysis/ui.R
+++ b/program/shinyApp/R/significance_analysis/ui.R
@@ -1,6 +1,7 @@
significance_analysis_sidebar_ui<- function(ns){
sidebarPanel(
id = "sidebar_significance_analysis",
+ h5(" ") %>% helper(type = "markdown", content = "SigAna_Choices"),
# UI to choose type of comparison
uiOutput(outputId = ns("type_of_comparison_ui")),
# UI to choose comparisons
@@ -38,6 +39,11 @@ significance_analysis_main_ui <- function(ns){
# UI for visualization Plot
plotOutput(outputId = ns("Significant_Plot_final")),
# UI to select comparisons to visualize
+ splitLayout( # Only used for questionmark
+ cellWidths = c("26%", "74%"),
+ h4("Visualization Choices") %>% helper(type = "markdown", content = "SigAna_Vis"),
+ NULL
+ ),
uiOutput(outputId = ns("chooseComparisonsToVisualize_ui")),
# UI to choose visualization method
uiOutput(outputId = ns("chooseVisualization_ui")),
@@ -51,7 +57,7 @@ significance_analysis_main_ui <- function(ns){
outputId = ns("downloadIntersections"),
label = "Download Intersections",
class = "btn-info"
- ),
+ ) %>% helper(type = "markdown", content = "SigAna_Intersections"),
# Download and Report UI
splitLayout(
style = "border: 1px solid silver:",
@@ -61,7 +67,7 @@ significance_analysis_main_ui <- function(ns){
inputId = ns("only2Report_Sig"),
label = "Send only to Report",
class = "btn-info"
- )
+ ) %>% helper(type = "markdown", content = "SigAna_Downloads")
),
splitLayout(
style = "border: 1px solid silver:",
diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R
index da598f40..69e62c1e 100644
--- a/program/shinyApp/R/significance_analysis/util.R
+++ b/program/shinyApp/R/significance_analysis/util.R
@@ -71,15 +71,129 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n
inputId = targetPanel,
tabPanel(
title = title,
- # summary of the results
- h4(paste("Summary of the results comparing ", contrast[1], " and ", contrast[2])),
- htmlOutput(outputId = ns(paste(contrast[1], contrast[2], "summary", sep = "_")), container = pre),
- # create table with results, that allows filtering
- DT::dataTableOutput(outputId = ns(paste(contrast[1], contrast[2], "table", sep = "_")))
+ tabsetPanel(
+ # Table
+ tabPanel(
+ title = "Table",
+ # summary of the results
+ h4(paste("Summary of the results comparing ", contrast[1], " and ", contrast[2])),
+ htmlOutput(outputId = ns(paste(contrast[1], contrast[2], "summary", sep = "_")), container = pre),
+ # create table with results, that allows filtering
+ DT::dataTableOutput(outputId = ns(paste(contrast[1], contrast[2], "table", sep = "_")))
+ ),
+ tabPanel(
+ title = "Volcano",
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("40%", "60%"),
+ plotlyOutput(
+ outputId = ns(paste(contrast[1], contrast[2], "Volcano", sep = "_"))
+ ) %>% withSpinner(type = 8),
+ plotlyOutput(
+ outputId = ns(paste(contrast[1], contrast[2], "Volcano_praw", sep = "_"))
+ )
+ ),
+ hr(style = "border-top: 1px solid #000000;"),
+ uiOutput(outputId = ns(paste(contrast[1], contrast[2], "psig_th_ui", sep = "_"))),
+ uiOutput(outputId = ns(paste(contrast[1], contrast[2], "lfc_th_ui", sep = "_"))),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ h5("Volcano plot padj"),
+ h5("Both Volcano plots") %>% helper(type = "markdown", content = "SigAna_VolcanoDownloads"),
+ h5("Volcano plot pvalue")
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ actionButton(
+ inputId = ns("only2Report_Volcano"),
+ label = "Send only to Report",
+ class = "btn-info"
+ ),
+ actionButton(
+ inputId = ns("only2Report_Volcano_both"),
+ label = "Send only to Report",
+ class = "btn-info"
+ ),
+ actionButton(
+ inputId = ns("only2Report_Volcano_raw"),
+ label = "Send only to Report",
+ class = "btn-info"
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ ),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano_both"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ ),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano_raw"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano"),
+ label = "Save plot",
+ class = "btn-info"
+ ),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano_both"),
+ label = "Save plot",
+ class = "btn-info"
+ ),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano_raw"),
+ label = "Save plot",
+ class = "btn-info"
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ ),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano_both"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ ),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano_raw"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ )
+ )
+ )
+ )
)
)
# server part of tabPanel
- # print the summary of the results
+ # reactive values
+ sig_ana_reactive <- reactiveValues(
+ th_psig = NULL,
+ th_lfc = NULL,
+ very_first_start = NULL
+ )
+ # print the summary of the results into the table
output[[ns(paste(contrast[1], contrast[2], "summary", sep = "_"))]] <- renderText(
paste(resume, collapse = "
")
)
@@ -87,7 +201,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n
data = result,
extensions = 'Buttons',
filter = 'top',
- rownames = FALSE,
+ rownames = T,
colnames = c('Gene' = 1),
options = list(
paging = TRUE,
@@ -95,13 +209,178 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
- order = list(list(2, 'asc'), list(1, 'asc')), # 2=padj, 1=pvalue
+ order = list(list(4, 'asc'), list(5, 'asc')), # 4=padj, 5=pvalue
dom = 'Bfrtip',
lengthMenu = c(10, 25, 50, 100, -1),
buttons = c('pageLength', 'copy', 'csv', 'excel')
),
class = "cell-border compact stripe hover order-column"
)})
+
+ psig_th <- ns(paste(contrast[1], contrast[2], "psig_th", sep = "_"))
+ lfc_th <- ns(paste(contrast[1], contrast[2], "lfc_th", sep = "_"))
+ output[[ns(paste(contrast[1], contrast[2], "psig_th_ui", sep = "_"))]] <- renderUI({
+ numericInput(
+ inputId = ns(paste(contrast[1], contrast[2], "psig_th", sep = "_")),
+ label = "adj. p-value threshold",
+ min=0,
+ max=0.1,
+ step=0.01,
+ value = 0.05
+ )
+ })
+ output[[ns(paste(contrast[1], contrast[2], "lfc_th_ui", sep = "_"))]] <- renderUI({
+ numericInput(
+ inputId = lfc_th,
+ label = "Log FC threshold (both sides!)",
+ min = 0,
+ max = 10,
+ step = 0.1,
+ value = 1.0
+ )
+ })
+ if(is.null(sig_ana_reactive$very_first_start)){
+ sig_ana_reactive$very_first_start <- TRUE
+ }
+ toPlotVolcano <- reactive({
+ list(
+ input[[psig_th]],
+ input[[lfc_th]],
+ sig_ana_reactive$very_first_start
+ )
+ })
+ observeEvent(toPlotVolcano(), {
+ # workaround, as somehow the input values dont show up unless we change it in the shiny
+ # TODO: fix this (@Lea?)
+ sig_ana_reactive$th_psig <- ifelse(is.null(input[[psig_th]]), 0.05, input[[psig_th]])
+ sig_ana_reactive$th_lfc <- ifelse(is.null(input[[lfc_th]]), 1, input[[lfc_th]])
+ # plot volcano plot
+ data4Volcano <- result
+ data4Volcano$probename <- rownames(data4Volcano)
+ data4Volcano$threshold <- ifelse(data4Volcano$padj>sig_ana_reactive$th_psig,"non-significant","significant")
+ data4Volcano$threshold_raw <- ifelse(data4Volcano$pvalue>sig_ana_reactive$th_psig,"non-significant","significant")
+ data4Volcano$threshold_fc <- ifelse(
+ data4Volcano$log2FoldChange>sig_ana_reactive$th_lfc,
+ "up-regulated",
+ ifelse(
+ data4Volcano$log2FoldChange<(-sig_ana_reactive$th_lfc),
+ "down-regulated", " "
+ )
+ )
+ data4Volcano$combined <- paste0(data4Volcano$threshold," + ",data4Volcano$threshold_fc)
+ data4Volcano$combined_raw <- paste0(data4Volcano$threshold_raw," + ",data4Volcano$threshold_fc)
+ colorScheme2 <- c("#cf0e5bCD", "#0e5bcfCD", "#939596CD","#cf0e5b1A", "#0e5bcf1A", "#9395961A")
+ names(colorScheme2) <- c(
+ "significant + up-regulated", "significant + down-regulated", "significant + ",
+ "non-significant + up-regulated", "non-significant + down-regulated", "non-significant + "
+ )
+
+ # remove NA values
+ sig_ana_reactive$data4Volcano <- data4Volcano[complete.cases(data4Volcano),]
+
+ sig_ana_reactive$VolcanoPlot <- ggplot(
+ sig_ana_reactive$data4Volcano,
+ aes(label=probename)
+ ) +
+ geom_point(aes(
+ x = log2FoldChange,
+ y = -log10(padj),
+ colour = combined
+ )) +
+ geom_hline(
+ yintercept = -log10(sig_ana_reactive$th_psig),
+ color="lightgrey"
+ ) +
+ geom_vline(
+ xintercept = c(-sig_ana_reactive$th_lfc,sig_ana_reactive$th_lfc),
+ color="lightgrey"
+ ) +
+ scale_color_manual(values=colorScheme2, name="") +
+ xlab("Log FoldChange") +
+ ylab("-log10(p_adj-value)") +
+ theme(legend.position = "none") +
+ theme_bw()+
+ ggtitle(label="Corrected p-Values")
+ output[[ns(paste(contrast[1], contrast[2], "Volcano", sep = "_"))]] <- renderPlotly({ggplotly(
+ sig_ana_reactive$VolcanoPlot,
+ legendgroup="color"
+ )})
+ sig_ana_reactive$VolcanoPlot_raw <- ggplot(
+ sig_ana_reactive$data4Volcano,
+ aes(label=probename)
+ ) +
+ geom_point(aes(
+ x = log2FoldChange,
+ y = -log10(pvalue),
+ colour = combined_raw)) +
+ geom_hline(
+ yintercept = -log10(sig_ana_reactive$th_psig),
+ color="lightgrey"
+ ) +
+ geom_vline(
+ xintercept = c(-sig_ana_reactive$th_lfc,sig_ana_reactive$th_lfc),
+ color="lightgrey"
+ ) +
+ scale_color_manual(values=colorScheme2, name="") +
+ xlab("Log FoldChange") +
+ ylab("-log10(p-value)") +
+ theme_bw()+
+ ggtitle(label="Uncorrected p-Values")
+ output[[ns(paste(contrast[1], contrast[2], "Volcano_praw", sep = "_"))]] <- renderPlotly({ggplotly(
+ sig_ana_reactive$VolcanoPlot_raw,
+ legendgroup="color"
+ )})
+ })
+
+ # downloadhandlers
+ observeEvent(input[[ns("only2Report_Volcano")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ })
+ observeEvent(input[[ns("only2Report_Volcano_raw")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ observeEvent(input[[ns("only2Report_Volcano_both")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ output[[ns("SavePlot_Volcano")]] <- downloadHandler(
+ filename = function() { paste("VOLCANO_",Sys.time(),input[[ns("file_ext_Volcano")]],sep="") },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = sig_ana_reactive$VolcanoPlot,
+ device = gsub("\\.","",input[[ns("file_ext_Volcano")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
+ output[[ns("SavePlot_Volcano_raw")]] <- downloadHandler(
+ filename = function() { paste("raw_VOLCANO",Sys.time(),input[[ns("file_ext_Volcano_raw")]],sep="") },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = sig_ana_reactive$VolcanoPlot_raw,
+ device = gsub("\\.","",input[[ns("file_ext_Volcano_raw")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
+ output[[ns("SavePlot_Volcano_both")]] <- downloadHandler(
+ filename = function() { paste0("VOLCANO_",Sys.time(),input[[ns("file_ext_Volcano")]]) },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = gridExtra::arrangeGrob(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$VolcanoPlot),
+ device = gsub("\\.","",input[[ns("file_ext_Volcano")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
+
}
@@ -161,14 +440,128 @@ create_new_tab_DESeq <- function(title, targetPanel, result, contrast, alpha, ns
inputId = targetPanel,
tabPanel(
title = title,
- # summary of the results
- h4(paste("Summary of the results comparing ", contrast[1], " and ", contrast[2])),
- htmlOutput(outputId = ns(paste(contrast[1], contrast[2], "summary", sep = "_")), container = pre),
- # create table with results, that allows filtering
- DT::dataTableOutput(outputId = ns(paste(contrast[1], contrast[2], "table", sep = "_")))
+ tabsetPanel(
+ # Table
+ tabPanel(
+ title = "Table",
+ # summary of the results
+ h4(paste("Summary of the results comparing ", contrast[1], " and ", contrast[2])),
+ htmlOutput(outputId = ns(paste(contrast[1], contrast[2], "summary", sep = "_")), container = pre),
+ # create table with results, that allows filtering
+ DT::dataTableOutput(outputId = ns(paste(contrast[1], contrast[2], "table", sep = "_")))
+ ),
+ tabPanel(
+ title = "Volcano",
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("40%", "60%"),
+ plotlyOutput(
+ outputId = ns(paste(contrast[1], contrast[2], "Volcano", sep = "_"))
+ ) %>% withSpinner(type = 8),
+ plotlyOutput(
+ outputId = ns(paste(contrast[1], contrast[2], "Volcano_praw", sep = "_"))
+ )
+ ),
+ hr(style = "border-top: 1px solid #000000;"),
+ uiOutput(outputId = ns(paste(contrast[1], contrast[2], "psig_th_ui", sep = "_"))),
+ uiOutput(outputId = ns(paste(contrast[1], contrast[2], "lfc_th_ui", sep = "_"))),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ h5("Volcano plot padj"),
+ h5("Both Volcano plots"),
+ h5("Volcano plot pvalue")
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ actionButton(
+ inputId = ns("only2Report_Volcano"),
+ label = "Send only to Report",
+ class = "btn-info"
+ ),
+ actionButton(
+ inputId = ns("only2Report_Volcano_both"),
+ label = "Send only to Report",
+ class = "btn-info"
+ ),
+ actionButton(
+ inputId = ns("only2Report_Volcano_raw"),
+ label = "Send only to Report",
+ class = "btn-info"
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ ),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano_both"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ ),
+ downloadButton(
+ outputId = ns("getR_Code_Volcano_raw"),
+ label = "Get underlying R code and data",
+ icon = icon("code")
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano"),
+ label = "Save plot",
+ class = "btn-info"
+ ),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano_both"),
+ label = "Save plot",
+ class = "btn-info"
+ ),
+ downloadButton(
+ outputId = ns("SavePlot_Volcano_raw"),
+ label = "Save plot",
+ class = "btn-info"
+ )
+ ),
+ splitLayout(
+ style = "border: 1px solid silver:",
+ cellWidths = c("35%","35%", "30%"),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ ),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano_both"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ ),
+ radioGroupButtons(
+ inputId = ns("file_ext_Volcano_raw"),
+ label = "File Type:",
+ choices = c(".png", ".tiff", ".pdf"),
+ selected = ".png"
+ )
+ )
+ )
+ )
)
)
# server part of tabPanel
+ # reactive values
+ sig_ana_reactive <- reactiveValues(
+ th_psig = NULL,
+ th_lfc = NULL,
+ very_first_start = NULL
+ )
# print the summary of the results
output[[ns(paste(contrast[1], contrast[2], "summary", sep = "_"))]] <- renderText(
paste(resume, collapse = "
")
@@ -192,6 +585,168 @@ create_new_tab_DESeq <- function(title, targetPanel, result, contrast, alpha, ns
),
class = "cell-border compact stripe hover order-column"
)})
+
+ psig_th <- ns(paste(contrast[1], contrast[2], "psig_th", sep = "_"))
+ lfc_th <- ns(paste(contrast[1], contrast[2], "lfc_th", sep = "_"))
+ output[[ns(paste(contrast[1], contrast[2], "psig_th_ui", sep = "_"))]] <- renderUI({
+ numericInput(
+ inputId = ns(paste(contrast[1], contrast[2], "psig_th", sep = "_")),
+ label = "adj. p-value threshold",
+ min=0,
+ max=0.1,
+ step=0.01,
+ value = 0.05
+ )
+ })
+ output[[ns(paste(contrast[1], contrast[2], "lfc_th_ui", sep = "_"))]] <- renderUI({
+ numericInput(
+ inputId = lfc_th,
+ label = "Log FC threshold (both sides!)",
+ min = 0,
+ max = 10,
+ step = 0.1,
+ value = 1.0
+ )
+ })
+ if(is.null(sig_ana_reactive$very_first_start)){
+ sig_ana_reactive$very_first_start <- TRUE
+ }
+ toPlotVolcano <- reactive({
+ list(
+ input[[psig_th]],
+ input[[lfc_th]],
+ sig_ana_reactive$very_first_start
+ )
+ })
+ observeEvent(toPlotVolcano(), {
+ # workaround, as somehow the input values dont show up unless we change it in the shiny
+ # TODO: fix this (@Lea?)
+ sig_ana_reactive$th_psig <- ifelse(is.null(input[[psig_th]]), 0.05, input[[psig_th]])
+ sig_ana_reactive$th_lfc <- ifelse(is.null(input[[lfc_th]]), 1, input[[lfc_th]])
+ # plot volcano plot
+ data4Volcano <- as.data.frame(result)
+ data4Volcano$probename <- rownames(data4Volcano)
+ data4Volcano$threshold <- ifelse(data4Volcano$padj>sig_ana_reactive$th_psig,"non-significant","significant")
+ data4Volcano$threshold_raw <- ifelse(data4Volcano$pvalue>sig_ana_reactive$th_psig,"non-significant","significant")
+ data4Volcano$threshold_fc <- ifelse(
+ data4Volcano$log2FoldChange>sig_ana_reactive$th_lfc,
+ "up-regulated",
+ ifelse(
+ data4Volcano$log2FoldChange<(-sig_ana_reactive$th_lfc),
+ "down-regulated", " "
+ )
+ )
+ data4Volcano$combined <- paste0(data4Volcano$threshold," + ",data4Volcano$threshold_fc)
+ data4Volcano$combined_raw <- paste0(data4Volcano$threshold_raw," + ",data4Volcano$threshold_fc)
+ colorScheme2 <- c("#cf0e5bCD", "#0e5bcfCD", "#939596CD","#cf0e5b1A", "#0e5bcf1A", "#9395961A")
+ names(colorScheme2) <- c(
+ "significant + up-regulated", "significant + down-regulated", "significant + ",
+ "non-significant + up-regulated", "non-significant + down-regulated", "non-significant + "
+ )
+
+ # remove NA values
+ sig_ana_reactive$data4Volcano <- data4Volcano[complete.cases(data4Volcano),]
+
+ sig_ana_reactive$VolcanoPlot <- ggplot(
+ sig_ana_reactive$data4Volcano,
+ aes(label=probename)
+ ) +
+ geom_point(aes(
+ x = log2FoldChange,
+ y = -log10(padj),
+ colour = combined
+ )) +
+ geom_hline(
+ yintercept = -log10(sig_ana_reactive$th_psig),
+ color="lightgrey"
+ ) +
+ geom_vline(
+ xintercept = c(-sig_ana_reactive$th_lfc,sig_ana_reactive$th_lfc),
+ color="lightgrey"
+ ) +
+ scale_color_manual(values=colorScheme2, name="") +
+ xlab("Log FoldChange") +
+ ylab("-log10(p-value)") +
+ theme(legend.position = "none") +
+ ggtitle(label="Corrected p-Values")
+ output[[ns(paste(contrast[1], contrast[2], "Volcano", sep = "_"))]] <- renderPlotly({ggplotly(
+ sig_ana_reactive$VolcanoPlot,
+ legendgroup="color"
+ )})
+ sig_ana_reactive$VolcanoPlot_raw <- ggplot(
+ sig_ana_reactive$data4Volcano,
+ aes(label=probename)
+ ) +
+ geom_point(aes(
+ x = log2FoldChange,
+ y = -log10(pvalue),
+ colour = combined_raw)) +
+ geom_hline(
+ yintercept = -log10(sig_ana_reactive$th_psig),
+ color="lightgrey"
+ ) +
+ geom_vline(
+ xintercept = c(-sig_ana_reactive$th_lfc,sig_ana_reactive$th_lfc),
+ color="lightgrey"
+ ) +
+ scale_color_manual(values=colorScheme2, name="") +
+ xlab("Log FoldChange") +
+ ylab("-log10(p-value)") +
+ ggtitle(label="Uncorrected p-Values")
+ output[[ns(paste(contrast[1], contrast[2], "Volcano_praw", sep = "_"))]] <- renderPlotly({ggplotly(
+ sig_ana_reactive$VolcanoPlot_raw,
+ legendgroup="color"
+ )})
+ })
+
+ # downloadhandlers
+ observeEvent(input[[ns("only2Report_Volcano")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ })
+ observeEvent(input[[ns("only2Report_Volcano_raw")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ observeEvent(input[[ns("only2Report_Volcano_both")]],{
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ output[[ns("SavePlot_Volcano")]] <- downloadHandler(
+ filename = function() { paste("VOLCANO_",Sys.time(),input[[ns("file_ext_Volcano")]],sep="") },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = sig_ana_reactive$VolcanoPlot,
+ device = gsub("\\.","",input[[ns("file_ext_Volcano")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
+ output[[ns("SavePlot_Volcano_raw")]] <- downloadHandler(
+ filename = function() { paste("raw_VOLCANO",Sys.time(),input[[ns("file_ext_Volcano_raw")]],sep="") },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = sig_ana_reactive$VolcanoPlot_raw,
+ device = gsub("\\.","",input[[ns("file_ext_Volcano_raw")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
+ output[[ns("SavePlot_Volcano_both")]] <- downloadHandler(
+ filename = function() { paste0("VOLCANO_",Sys.time(),input[[ns("file_ext_Volcano")]]) },
+ content = function(file){
+ ggsave(
+ filename = file,
+ plot = gridExtra::arrangeGrob(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$VolcanoPlot),
+ device = gsub("\\.","",input[[ns("file_ext_Volcano")]])
+ )
+ on.exit({
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot, sig_ana_reactive$data4Volcano, contrast)
+ log_messages_volcano(sig_ana_reactive$VolcanoPlot_raw, sig_ana_reactive$data4Volcano, contrast)
+ })
+ })
}
@@ -228,7 +783,12 @@ significance_analysis <- function(
tryCatch(
{
results <- test_function(x, y)
- return(results$p.value)
+ return(list(
+ "pvalue" = results$p.value,
+ "baseMean" = results$estimate[[2]],
+ "treatMean" = results$estimate[[1]],
+ "stat" = results$statistic
+ ))
},
error = function(e) {
cat(
@@ -248,6 +808,16 @@ significance_analysis <- function(
# introduce a running parameter alongside the loop for the name
comp_name <- 1
for(contrast in contrasts){
+ # skip if already there
+ if(identical(
+ list(test_method = method, test_correction = correction),
+ par_tmp$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]]]
+ comp_name <- comp_name + 1
+ next
+ }
# get the samples for the comparison
idx <- rownames(samples[samples[contrast_level] == contrast[[1]],, drop = FALSE])
idy <- rownames(samples[samples[contrast_level] == contrast[[2]],, drop = FALSE])
@@ -259,14 +829,33 @@ significance_analysis <- function(
grp1 = idx,
grp2 = idy
)
- # create a dataframe with the results
- res <- data.frame(
- gene = rownames(df),
- pvalue = res,
- padj = p.adjust(res, method = correction),
- stringsAsFactors = FALSE
+ res <- as.data.frame(do.call(rbind, res))
+ # turn columns to numerics again
+ res <- transform(
+ res,
+ baseMean=as.numeric(baseMean),
+ treatMean=as.numeric(treatMean),
+ pvalue=as.numeric(pvalue),
+ stat=as.numeric(stat)
)
+ means <- subset(res, select = c(baseMean,treatMean))
+ # drop mean of treatment
+ res <- subset(res, select = -c(treatMean))
+ # create a dataframe with the results
+ res$padj <- p.adjust(res$pvalue, method = correction)
+ res$log2FoldChange <- getLFC(means)
+ res <- transform(res, pvalue=as.numeric(pvalue),
+ baseMean=as.numeric(baseMean), stat=as.numeric(stat))
+
+
+
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(
+ test_method = method,
+ test_correction = correction
+ )
comp_name <- comp_name + 1
}
return(sig_results)
@@ -301,3 +890,74 @@ map_intersects_for_highlight <- function(highlights, plot, overlap_list){
}
return(querie_names)
}
+
+
+getLFC <- function(means){
+ # define function to calculate LFC in case of ln or log10 preprocessing
+ # and all other cases
+ lfc_per_gene <- function(df){
+ df$LFC <- log2(df$treatMean)-log2(df$baseMean)
+ # NA, Inf, -Inf and NaN values will bet set to NA
+ # NA if the means are NA
+ df$LFC[is.nan(df$LFC)] <- NA # NaN if both means 0
+ # Inf if baseMean==0, -Inf if treatMean==0
+ df$LFC[is.infinite(df$LFC)] <- NA
+ # print the rownames of NA values
+ cat(
+ "For the following genes, no meaningfull log fold change can be calculated:\n",
+ rownames(df[is.na(df$LFC),]),
+ "\nThis is caused by either one of the mean values being 0 or by NAs in the testing."
+ )
+ return (df$LFC)
+ }
+ lfc_per_gene_log <- function(df, log_base){
+ df$LFC <- log2(log_base**(df$treatMean-df$baseMean))
+ # NA, Inf, -Inf and NaN values will bet set to NA
+ # NA if the means are NA
+ df$LFC[is.nan(df$LFC)] <- NA # NaN if both means 0
+ # Inf if baseMean==0, -Inf if treatMean==0
+ df$LFC[is.infinite(df$LFC)] <- NA
+ # print the rownames of NA values
+ cat(
+ "For the following genes, no meaningfull log fold change can be calculated:\n",
+ rownames(df[is.na(df$LFC),]),
+ "\nThis is caused by either one of the mean values being 0 or by NAs in the testing."
+ )
+ return (df$LFC)
+ }
+ if(par_tmp$PreProcessing_Procedure == "log10"){
+ lfc_per_gene_log(means, log_base = 10)
+ }else if(par_tmp$PreProcessing_Procedure == "ln"){
+ lfc_per_gene_log(means, log_base = exp(1))
+ }else{
+ lfc_per_gene(means)
+ }
+}
+
+
+log_messages_volcano<- function(plot, table, contrast){
+ notificationID <- showNotification("Saving...",duration = 0)
+
+ tmp_filename <- paste0(
+ getwd(),"/www/",paste(paste0("VOLCANO_", Sys.time(), ".png"))
+ )
+
+ ggsave(tmp_filename, plot=plot, device = "png")
+
+ # Add Log Messages
+ fun_LogIt(message = "## VOLCANO")
+ fun_LogIt(message = paste(
+ "**VOLCANO** - Underlying Volcano Comparison:", contrast[2],"vs", contrast[2]
+ ))
+ fun_LogIt(message = paste0("**VOLCANO** - ![VOLCANO](",tmp_filename,")"))
+
+ fun_LogIt(message = paste0(
+ "**VOLCANO** - The top 10 diff Expressed are the following (sorted by adj. p.val)"
+ ))
+ fun_LogIt(message = paste0(
+ "**VOLCANO** - \n",knitr::kable(head(table[order(table$padj, table$pvalue),],10),format = "html")
+ ))
+
+ removeNotification(notificationID)
+ showNotification("Saved!",type = "message", duration = 1)
+}
diff --git a/program/shinyApp/R/single_gene_visualisation/ui.R b/program/shinyApp/R/single_gene_visualisation/ui.R
index 931f0fd6..b2c34c9d 100644
--- a/program/shinyApp/R/single_gene_visualisation/ui.R
+++ b/program/shinyApp/R/single_gene_visualisation/ui.R
@@ -1,7 +1,7 @@
single_gene_visualisation_sidebar_ui<- function(ns){
sidebarPanel(
id = "sidebar_single_gene_visualisation",
- uiOutput(outputId = ns("type_of_data_gene_ui")),
+ uiOutput(outputId = ns("type_of_data_gene_ui")) %>% helper(type = "markdown", content = "SingleGene_Options"),
uiOutput(outputId = ns("type_of_visualitsation_ui")),
uiOutput(outputId = ns("Select_GeneAnno_ui")),
uiOutput(outputId = ns("Select_Gene_ui")),
@@ -17,7 +17,7 @@ single_gene_visualisation_sidebar_ui<- function(ns){
label = "Refresh"
)),
hr(style = "border-top: 1px solid #858585;"),
- uiOutput(outputId = ns("accross_condition_ui"))
+ uiOutput(outputId = ns("accross_condition_ui")) %>% helper(type = "markdown", content = "SingleGene_Select")
)
}
@@ -31,7 +31,7 @@ single_gene_visualisation_main_ui <- function(ns){
NULL
),
h5(HTML("Note, that you only see boxplots if you have more than 3 samples per group")),
- uiOutput(outputId = ns("chooseComparisons_ui")),
+ uiOutput(outputId = ns("chooseComparisons_ui")) %>% helper(type = "markdown", content = "SingleGene_Comparisons"),
splitLayout(
style = "border: 1px solid silver:",
cellWidths = c("70%", "30%"),
@@ -40,7 +40,7 @@ single_gene_visualisation_main_ui <- function(ns){
inputId = ns("only2Report_SingleEntities"),
label = "Send only to Report",
class = "btn-info"
- ),
+ ) %>% helper(type = "markdown", content = "SingleGene_Download"),
),
splitLayout(
style = "border: 1px solid silver:",
diff --git a/program/shinyApp/R/volcano_plot/server.R b/program/shinyApp/R/volcano_plot/server.R
deleted file mode 100644
index 372f153f..00000000
--- a/program/shinyApp/R/volcano_plot/server.R
+++ /dev/null
@@ -1,485 +0,0 @@
-# Volcano Plot----
-volcano_Server <- function(id, data, params, updates){
-
- moduleServer(
- id,
- function(input,output,session){
- volcano_reactive <- reactiveValues(
- current_updates = 0,
- VolcanoPlot = NULL,
- LFCTable = NULL
- )
- ns <- session$ns
- ## UI Section----
- output$sample_annotation_types_cmp_ui <- renderUI({
- req(data_input_shiny())
- selectInput(
- inputId = ns("sample_annotation_types_cmp"),
- label = "Choose type for LFC comparison",
- choices = c(colnames(colData(data$data))),
- multiple = F ,
- selected = NULL
- )
- })
- output$Groups2Compare_ref_ui <- renderUI({
- req(data_input_shiny())
- req(input$sample_annotation_types_cmp)
- selectInput(
- inputId = ns("Groups2Compare_ref"),
- label = "Choose reference of log2 FoldChange",
- choices = unique(colData(data$data)[,input$sample_annotation_types_cmp]),
- multiple = F ,
- selected = unique(colData(data$data)[,input$sample_annotation_types_cmp])[1]
- )
- })
- output$Groups2Compare_treat_ui <- renderUI({
- req(data_input_shiny())
- req(input$sample_annotation_types_cmp)
- print(colData(data$data)[,input$sample_annotation_types_cmp])
- selectInput(
- inputId = ns("Groups2Compare_treat"),
- label = "Choose treatment group of log2 FoldChange",
- choices = unique(colData(data$data)[,input$sample_annotation_types_cmp]),
- multiple = F ,
- selected = unique(colData(data$data)[,input$sample_annotation_types_cmp])[2]
- )
- })
-
- output$chooseTest_ui <- renderUI({
- shinyWidgets::virtualSelectInput(
- search = T,
- showSelectedOptionsFirst = T,
- inputId = ns("chooseTest"),
- label = "Test method",
- choices = c("Wilcoxon rank sum test", "T-Test", "Welch-Test"),
- selected = "T-Test"
- )
- })
-
- output$chooseSignificanceLevel_ui <- renderUI({
- sliderInput(
- inputId = ns("significance_level"),
- label = "Significance level",
- min = 0.005,
- max = 0.1,
- value = 0.05,
- step = 0.005
- )
- })
-
- output$chooseTestCorrection_ui <- renderUI({
- selectInput(
- inputId = ns("chooseTestCorrection"),
- label = "Test correction",
- choices = c(
- "None", "Bonferroni", "Benjamini-Hochberg", "Benjamini Yekutieli",
- "Holm", "Hommel", "Hochberg", "FDR"
- ),
- selected = "Benjamini-Hochberg"
- )
- })
-
-
-
-
- output$psig_threhsold_ui <- renderUI({
- req(data_input_shiny())
- numericInput(
- inputId = ns("psig_threhsold"),
- label = "adj. p-value threshold",
- min=0,
- max=0.1,
- step=0.01,
- value = 0.05
- )
- })
- output$lfc_threshold_ui <- renderUI({
- numericInput(
- inputId = ns("lfc_threshold"),
- label = "Log FC threshold (both sides!)",
- min = 0,
- max = 10,
- step = 0.1,
- value = 1.0
- )
- })
- output$VOLCANO_anno_tooltip_ui <- renderUI({
- req(data_input_shiny())
- selectInput(
- inputId = ns("VOLCANO_anno_tooltip"),
- label = "Select the anno to be shown at tooltip",
- choices = c(colnames(rowData(data$data))),
- multiple = F
- )
- })
- # refresh the UI/data if needed
- observeEvent(input$refreshUI, {
- data <- update_data(data, updates, volcano_reactive$current_updates)
- params <- update_params(params, updates, volcano_reactive$current_updates)
- volcano_reactive$current_updates <- updates()
- })
-
- toListen2Volcano <- reactive({
- list(
- input$Do_Volcano,
- input$psig_threhsold,
- input$lfc_threshold,
- input$get_entire_table,
- input$VOLCANO_anno_tooltip
- )
- })
- ## Do Volcano----
- observeEvent(toListen2Volcano(),{
- req(
- isTruthy(selectedData_processed()),
- input$sample_annotation_types_cmp,
- input$psig_threhsold,
- input$lfc_threshold,
- input$Do_Volcano[1] >= 1
- )
- print("Volcano analysis on pre-selected data")
- print(input$sample_annotation_types_cmp)
- ctrl_samples_idx <- which(
- colData(data$data)[,input$sample_annotation_types_cmp] %in% input$Groups2Compare_ref
- )
- comparison_samples_idx <- which(
- colData(data$data)[,input$sample_annotation_types_cmp] %in% input$Groups2Compare_treat
- )
-
- if(length(comparison_samples_idx) <= 1 |
- length(ctrl_samples_idx)<=1){
- output$debug <- renderText(
- "Choose variable with at least two samples per condition!"
- )
- req(FALSE)
- }
- if(params$PreProcessing_Procedure=="simpleCenterScaling"){
- print("Remember do not use normal center + scaling (negative Values!)")
- output$debug <- renderText(
- "Choose another preprocessing, as there are negative values!"
- )
- req(FALSE)
- }else{
- if(params$PreProcessing_Procedure == "ln" | params$PreProcessing_Procedure == "log10" ){
- print("Data was logged already => delog, take FC and log ?!")
- if(params$PreProcessing_Procedure == "ln"){
- data2Volcano <- as.data.frame(exp(assay(data$data)))
- }else{
- data2Volcano <- as.data.frame(10^(assay(data$data)))
- }
- }else{
- data2Volcano <- as.data.frame(assay(data$data))
- }
- if(any(data2Volcano == 0)){
- # constant row are kicked out, mean of 0 only problem left - need to
- # be thrown out (plotted elsewhere?)
- }
- print(dim(data2Volcano))
- # If "none" for test correction is selected
- # we decided to always show a corrected plot
-
- if(input$chooseTestCorrection == "None"){
- VolcanoPlot_df_default <- Volcano_Plot(
- data = data2Volcano,
- ctrl_samples_idx = ctrl_samples_idx,
- comparison_samples_idx = comparison_samples_idx,
- p_sig_threshold = input$psig_threhsold,
- LFC_threshold = input$lfc_threshold,
- correction_test_method = "Benjamini-Hochberg",
- method = input$chooseTest,
- annotation_add = input$VOLCANO_anno_tooltip,
- annoData = rowData(data$data)
- )
- }else{
- VolcanoPlot_df_default <- NULL
- }
-
- VolcanoPlot_df <- Volcano_Plot(
- data = data2Volcano,
- ctrl_samples_idx = ctrl_samples_idx,
- comparison_samples_idx = comparison_samples_idx,
- p_sig_threshold = input$psig_threhsold,
- LFC_threshold = input$lfc_threshold,
- correction_test_method = input$chooseTestCorrection,
- method = input$chooseTest,
- annotation_add = input$VOLCANO_anno_tooltip,
- annoData = rowData(data$data)
- )
-
-
- # assign res_temp
- res_tmp[["Volcano"]] <<- VolcanoPlot_df
- # assign par_temp
- par_tmp[["Volcano"]] <<- list(
- "sample_annotation_types_cmp" = input$sample_annotation_types_cmp,
- "Groups2Compare_ref" = input$Groups2Compare_ref,
- "Groups2Compare_treat" = input$Groups2Compare_treat,
- "psig_threhsold" = input$psig_threhsold,
- "lfc_threshold" = input$lfc_threshold
- )
- colorScheme <- c("#cf0e5b","#939596")
- names(colorScheme) <- c("significant","non-significant")
- alphaScheme <- c(0.8,0.1)
- names(alphaScheme) <- c("change"," ")
-
- VolcanoPlot <- ggplot(
- VolcanoPlot_df,
- aes(label=probename,tooltip=annotation_add)
- ) +
- geom_point(aes(
- x = LFC,
- y = -log10(p_adj),
- colour = threshold,
- alpha = threshold_fc)) +
- geom_hline(
- yintercept = -log10(input$psig_threhsold),
- color="lightgrey"
- ) +
- geom_vline(
- xintercept = c(-input$lfc_threshold,input$lfc_threshold),
- color="lightgrey"
- ) +
- scale_color_manual(values=colorScheme, name="")+
- scale_alpha_manual(values=alphaScheme, name="")+
- xlab("Log FoldChange")+
- ylab("-log10(p-value)")+
- theme_bw()+
- ggtitle(label=ifelse(is.null(VolcanoPlot_df_default),
- "corrected pVals on y-Axis",
- "Uncorrected pVals on y-Axis"))
-
- plotPosition <- "Volcano_Plot_final"
- scenario <- 9
- scenario_Volcano <- scenario
-
- output[[plotPosition]] <- renderPlotly({ggplotly(
- VolcanoPlot,
- tooltip = ifelse(!is.null(input$VOLCANO_anno_tooltip),"tooltip","all"),
- legendgroup="color"
- )})
-
- if(!is.null(VolcanoPlot_df_default)){
- VolcanoPlot_default <- ggplot(
- VolcanoPlot_df_default,
- aes(label=probename,tooltip=annotation_add)
- ) +
- geom_point(aes(
- x = LFC,
- y = -log10(p_adj),
- colour = threshold,
- alpha = threshold_fc)) +
- geom_hline(
- yintercept = -log10(input$psig_threhsold),
- color="lightgrey"
- ) +
- geom_vline(
- xintercept = c(-input$lfc_threshold,input$lfc_threshold),
- color="lightgrey"
- ) +
- scale_color_manual(values=colorScheme, name="")+
- scale_alpha_manual(values=alphaScheme, name="")+
- xlab("Log FoldChange")+
- ylab("-log10(p-value)")+
- theme_bw()+
- theme(legend.position = "none")+
- ggtitle("BH-corrected p-Vals on y Axis")
-
- plotPosition <- "Volcano_Plot_final_default"
-
-
- output[[plotPosition]] <- renderPlotly({ggplotly(
- VolcanoPlot_default,
- tooltip = ifelse(!is.null(input$VOLCANO_anno_tooltip),"tooltip","all"),
- legendgroup="color"
- )})
- }else{
- plotPosition <- "Volcano_Plot_final_default"
-
-
- output[[plotPosition]] <- NULL
- }
-
-
- # LFC Table is VolcanoPlot_df but only the columns LFC, rawpvalue, p_adj, probename
- LFCTable <- VolcanoPlot_df[,c("LFC","rawpvalue","p_adj","probename")]
- # add annotation to Table
- LFCTable <- merge(
- LFCTable,
- rowData(data$data),
- by=0,
- all.x=TRUE,
- all.y=F
- )
- rownames(LFCTable) <- LFCTable$Row.names
- volcano_reactive$LFCTable <- as.data.frame(
- LFCTable[order(LFCTable$p_adj,decreasing = T),]
- )
- volcano_reactive$VolcanoPlot <- VolcanoPlot
-
- output$getR_Code_Volcano <- downloadHandler(
- filename = function(){
- paste("ShinyOmics_Rcode2Reproduce_", Sys.Date(), ".zip", sep = "")
- },
- content = function(file){
- envList <- list(
- VolcanoPlot_df = VolcanoPlot_df,
- input = reactiveValuesToList(input),
- colorScheme = colorScheme,
- alphaScheme = alphaScheme
- )
-
- temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
- dir.create(temp_directory)
- write(getPlotCode(scenario_Volcano), file.path(temp_directory, "Code.R"))
- saveRDS(object = envList, file = file.path(temp_directory, "Data.RDS"))
- zip::zip(
- zipfile = file,
- files = dir(temp_directory),
- root = temp_directory
- )
- },
- contentType = "application/zip"
- )
-
- output$SavePlot_Volcano <- downloadHandler(
- filename = function() { paste("VOLCANO_",Sys.time(),input$file_ext_Volcano,sep="") },
- content = function(file){
- ggsave(
- filename = file,
- plot = volcano_reactive$VolcanoPlot,
- device = gsub("\\.","",input$file_ext_Volcano)
- )
- on.exit({
- tmp_filename <- paste0(getwd(),"/www/",paste(paste("VOLCANO_",Sys.time(),input$file_ext_Volcano,sep="")))
- ggsave(
- filename = tmp_filename,
- plot = volcano_reactive$VolcanoPlot,
- device = gsub("\\.","",input$file_ext_Volcano)
- )
-
- # Add Log Messages
- fun_LogIt(message = "## VOLCANO")
- fun_LogIt(message = paste0(
- "**VOLCANO** - Underlying Volcano Comparison: ",
- input$sample_annotation_types_cmp,": ",
- input$Groups2Compare_ref," vs ", input$sample_annotation_types_cmp,": ",
- input$Groups2Compare_treat
- ))
- fun_LogIt(message = paste0("**VOLCANO** - ![VOLCANO](",tmp_filename,")"))
-
- fun_LogIt(message = paste0(
- "**VOLCANO** - The top 10 diff Expressed are the following (sorted by adj. p.val)"
- ))
- fun_LogIt(
- message = head(
- volcano_reactive$LFCTable[order(volcano_reactive$LFCTable$p_adj,decreasing = T),],10
- ),
- tableSaved=T
- )
- })
- }
-
- )
-
- output[["Volcano_table_final"]] <-DT::renderDataTable({DT::datatable(
- {volcano_reactive$LFCTable},
- extensions = 'Buttons',
- options = list(
- paging = TRUE,
- searching = TRUE,
- fixedColumns = TRUE,
- autoWidth = TRUE,
- ordering = TRUE,
- dom = 'Bfrtip',
- buttons = c('copy', 'csv', 'excel')
- ),
- class = "display"
- )})
- DE_UP <- subset(
- volcano_reactive$LFCTable,
- subset = (p_adj=input$lfc_threshold)
- )
- DE_DOWN <- subset(
- volcano_reactive$LFCTable,
- subset = p_adj