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% withSpinner(type = 8), - plotlyOutput(outputId = ns("Volcano_Plot_final_default")), - ), - uiOutput(outputId = ns("VOLCANO_anno_tooltip_ui")), - splitLayout( - style = "border: 1px solid silver:", - cellWidths = c("70%", "30%"), - NULL, - actionButton( - inputId = ns("only2Report_Volcano"), - label = "Send only to Report", - class = "btn-info" - ) - ), - splitLayout( - style = "border: 1px solid silver:", - cellWidths = c("70%", "30%"), - NULL, - downloadButton( - outputId = ns("getR_Code_Volcano"), - label = "Get underlying R code and data", - icon = icon("code") - ) - ), - splitLayout( - style = "border: 1px solid silver:", - cellWidths = c("70%", "30%"), - NULL, - downloadButton( - outputId = ns("SavePlot_Volcano"), - label = "Save plot", - class = "btn-info" - ) - ), - splitLayout( - style = "border: 1px solid silver:", - cellWidths = c("70%", "30%"), - NULL, - radioGroupButtons( - inputId = ns("file_ext_Volcano"), - label = "File Type:", - choices = c(".png", ".tiff", ".pdf"), - selected = ".png" - ) - ), - splitLayout( - style = "border: 1px solid silver:", - cellWidths = c("50%", "50%"), - downloadButton( - outputId = ns("SaveDE_List"), - label = "Save interesting entities (all red points)" - ), - actionButton( - inputId = ns("SendDE_Genes2Enrichment"), - label = "Send DE Genes to enrichment analysis", - block = F - ) - ) - ), - tabPanel( - title = "Volcano_table", - DT::dataTableOutput(outputId = ns("Volcano_table_final")) - ), - - ), - textAreaInput( - inputId = ns("NotesVolcano"), - label = "Notes:", - placeholder = NOTES_PlACEHOLDER, - width = "1000px" - )%>% helper(type = "markdown", content = "TakingNotesMD_help" - ), - helpText(NOTES_HELP) - ) -} - -volcano_UI <- function(id){ - ns <- NS(id) - - tabPanel( - title = "Volcano Plot", - id = "volcano", - fluid = T, - h4("Volcano Plot"), - volcano_sidebar <- volcano_sidebar_panel(ns), - volcano_main <- volcano_main_panel(ns), - ) -} \ No newline at end of file diff --git a/program/shinyApp/helpfiles/DataSelection_DataUploadFileInput.md b/program/shinyApp/helpfiles/DataSelection_DataUploadFileInput.md new file mode 100644 index 00000000..26f1652f --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_DataUploadFileInput.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_DataUploadFileInput.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_Matrix.md b/program/shinyApp/helpfiles/DataSelection_Matrix.md new file mode 100644 index 00000000..64ee3cba --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_Matrix.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_Matrix.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_MetaData.md b/program/shinyApp/helpfiles/DataSelection_MetaData.md new file mode 100644 index 00000000..f3829b55 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_MetaData.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_MetaData.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_Reset.md b/program/shinyApp/helpfiles/DataSelection_Reset.md new file mode 100644 index 00000000..2242260c --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_Reset.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_Reset.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_RowAnno.md b/program/shinyApp/helpfiles/DataSelection_RowAnno.md new file mode 100644 index 00000000..4db79196 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_RowAnno.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_RowAnno.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_RowSelection.md b/program/shinyApp/helpfiles/DataSelection_RowSelection.md new file mode 100644 index 00000000..7638fb55 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_RowSelection.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_RowSelection.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_SampleAnno.md b/program/shinyApp/helpfiles/DataSelection_SampleAnno.md new file mode 100644 index 00000000..b48dd2f9 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_SampleAnno.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_SampleAnno.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_SummarizedExp.md b/program/shinyApp/helpfiles/DataSelection_SummarizedExp.md new file mode 100644 index 00000000..ddaac54e --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_SummarizedExp.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_SummarizedExp.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_UploadInspection.md b/program/shinyApp/helpfiles/DataSelection_UploadInspection.md new file mode 100644 index 00000000..179f65fe --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_UploadInspection.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_UploadInspection.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSelection_compilation_help.md b/program/shinyApp/helpfiles/DataSelection_compilation_help.md new file mode 100644 index 00000000..26e127db --- /dev/null +++ b/program/shinyApp/helpfiles/DataSelection_compilation_help.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSelection_compilation_help.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSeletcion_MetaData.md b/program/shinyApp/helpfiles/DataSeletcion_MetaData.md new file mode 100644 index 00000000..b5664858 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSeletcion_MetaData.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/DataSeletcion_MetaData.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/DataSeletcion_Reset.md b/program/shinyApp/helpfiles/DataSeletcion_Reset.md new file mode 100644 index 00000000..a535f826 --- /dev/null +++ b/program/shinyApp/helpfiles/DataSeletcion_Reset.md @@ -0,0 +1 @@ +### Reset \ No newline at end of file diff --git a/program/shinyApp/helpfiles/EA_Download.md b/program/shinyApp/helpfiles/EA_Download.md new file mode 100644 index 00000000..5a101600 --- /dev/null +++ b/program/shinyApp/helpfiles/EA_Download.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/EA_Download.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/EA_GeneSets.md b/program/shinyApp/helpfiles/EA_GeneSets.md new file mode 100644 index 00000000..c6c75817 --- /dev/null +++ b/program/shinyApp/helpfiles/EA_GeneSets.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/EA_GeneSets.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/EA_Options.md b/program/shinyApp/helpfiles/EA_Options.md new file mode 100644 index 00000000..9ce37758 --- /dev/null +++ b/program/shinyApp/helpfiles/EA_Options.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/EA_Options.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/Heatmap_Aesthetics.md b/program/shinyApp/helpfiles/Heatmap_Aesthetics.md new file mode 100644 index 00000000..864b3acf --- /dev/null +++ b/program/shinyApp/helpfiles/Heatmap_Aesthetics.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/Heatmap_Aesthetics.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/Heatmap_Download.md b/program/shinyApp/helpfiles/Heatmap_Download.md new file mode 100644 index 00000000..f8b7cf1d --- /dev/null +++ b/program/shinyApp/helpfiles/Heatmap_Download.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/Heatmap_Download.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/Heatmap_FurtherOptions.md b/program/shinyApp/helpfiles/Heatmap_FurtherOptions.md new file mode 100644 index 00000000..ba00ef8a --- /dev/null +++ b/program/shinyApp/helpfiles/Heatmap_FurtherOptions.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/Heatmap_FurtherOptions.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/Heatmap_Options.md b/program/shinyApp/helpfiles/Heatmap_Options.md new file mode 100644 index 00000000..f84e602c --- /dev/null +++ b/program/shinyApp/helpfiles/Heatmap_Options.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/Heatmap_Options.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/Heatmap_RowAnnoBased.md b/program/shinyApp/helpfiles/Heatmap_RowAnnoBased.md new file mode 100644 index 00000000..3ac8e73d --- /dev/null +++ b/program/shinyApp/helpfiles/Heatmap_RowAnnoBased.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/Heatmap_RowAnnoBased.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_Choices.md b/program/shinyApp/helpfiles/PCA_Choices.md new file mode 100644 index 00000000..9b1c1368 --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_Choices.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_Choices.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_Downloads.md b/program/shinyApp/helpfiles/PCA_Downloads.md new file mode 100644 index 00000000..c470cddb --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_Downloads.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_Downloads.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_LoadingsDownload.md b/program/shinyApp/helpfiles/PCA_LoadingsDownload.md new file mode 100644 index 00000000..e1c04166 --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_LoadingsDownload.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_LoadingsDownload.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_LoadingsMatrixDownload.md b/program/shinyApp/helpfiles/PCA_LoadingsMatrixDownload.md new file mode 100644 index 00000000..59eba1ae --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_LoadingsMatrixDownload.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_LoadingsMatrixDownload.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_ScreeDownload.md b/program/shinyApp/helpfiles/PCA_ScreeDownload.md new file mode 100644 index 00000000..a646748a --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_ScreeDownload.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_ScreeDownload.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PCA_Tabpanels.md b/program/shinyApp/helpfiles/PCA_Tabpanels.md new file mode 100644 index 00000000..f44f8508 --- /dev/null +++ b/program/shinyApp/helpfiles/PCA_Tabpanels.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PCA_Tabpanels.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PreProcessing_DESeqMain.md b/program/shinyApp/helpfiles/PreProcessing_DESeqMain.md new file mode 100644 index 00000000..7f1ed677 --- /dev/null +++ b/program/shinyApp/helpfiles/PreProcessing_DESeqMain.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PreProcessing_DESeqMain.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PreProcessing_DESeqSub.md b/program/shinyApp/helpfiles/PreProcessing_DESeqSub.md new file mode 100644 index 00000000..734e52d9 --- /dev/null +++ b/program/shinyApp/helpfiles/PreProcessing_DESeqSub.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PreProcessing_DESeqSub.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/PreProcessing_Procedures.md b/program/shinyApp/helpfiles/PreProcessing_Procedures.md new file mode 100644 index 00000000..ca6d7257 --- /dev/null +++ b/program/shinyApp/helpfiles/PreProcessing_Procedures.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/PreProcessing_Procedures.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SampleCorr_Choices.md b/program/shinyApp/helpfiles/SampleCorr_Choices.md new file mode 100644 index 00000000..6ff87689 --- /dev/null +++ b/program/shinyApp/helpfiles/SampleCorr_Choices.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SampleCorr_Choices.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SampleCorr_Downloads.md b/program/shinyApp/helpfiles/SampleCorr_Downloads.md new file mode 100644 index 00000000..4fe41ab0 --- /dev/null +++ b/program/shinyApp/helpfiles/SampleCorr_Downloads.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SampleCorr_Downloads.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SigAna_Choices.md b/program/shinyApp/helpfiles/SigAna_Choices.md new file mode 100644 index 00000000..b86dc59f --- /dev/null +++ b/program/shinyApp/helpfiles/SigAna_Choices.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SigAna_Choices.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SigAna_Downloads.md b/program/shinyApp/helpfiles/SigAna_Downloads.md new file mode 100644 index 00000000..e43e1098 --- /dev/null +++ b/program/shinyApp/helpfiles/SigAna_Downloads.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SigAna_Downloads.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SigAna_Intersections.md b/program/shinyApp/helpfiles/SigAna_Intersections.md new file mode 100644 index 00000000..a9b5b588 --- /dev/null +++ b/program/shinyApp/helpfiles/SigAna_Intersections.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SigAna_Intersections.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SigAna_Vis.md b/program/shinyApp/helpfiles/SigAna_Vis.md new file mode 100644 index 00000000..e8146fcd --- /dev/null +++ b/program/shinyApp/helpfiles/SigAna_Vis.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SigAna_Vis.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SigAna_VolcanoDownloads.md b/program/shinyApp/helpfiles/SigAna_VolcanoDownloads.md new file mode 100644 index 00000000..bf477ff2 --- /dev/null +++ b/program/shinyApp/helpfiles/SigAna_VolcanoDownloads.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SigAna_VolcanoDownloads.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SingleGene_Comparisons.md b/program/shinyApp/helpfiles/SingleGene_Comparisons.md new file mode 100644 index 00000000..13293519 --- /dev/null +++ b/program/shinyApp/helpfiles/SingleGene_Comparisons.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SingleGene_Comparisons.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SingleGene_Download.md b/program/shinyApp/helpfiles/SingleGene_Download.md new file mode 100644 index 00000000..3203dece --- /dev/null +++ b/program/shinyApp/helpfiles/SingleGene_Download.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SingleGene_Download.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SingleGene_Options.md b/program/shinyApp/helpfiles/SingleGene_Options.md new file mode 100644 index 00000000..a41a2930 --- /dev/null +++ b/program/shinyApp/helpfiles/SingleGene_Options.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SingleGene_Options.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/helpfiles/SingleGene_Select.md b/program/shinyApp/helpfiles/SingleGene_Select.md new file mode 100644 index 00000000..c4d6c5b1 --- /dev/null +++ b/program/shinyApp/helpfiles/SingleGene_Select.md @@ -0,0 +1,6 @@ +### ShinyApp/helpfiles/SingleGene_Select.md - Under Development + +*** + +This helpfile is under not finished yet + diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index 7b0625f2..4a12b5cf 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -30,9 +30,12 @@ server <- function(input,output,session){ if(dir.exists("www")){ setwd("www") print(list.files()) - file.remove(list.files(path=".") %>% - setdiff(list.files(path=".", pattern = ".csv")) %>% - setdiff(list.files(path=".", pattern = ".RDS"))) + file.remove( + list.files(path=".") %>% + setdiff(list.files(path=".", pattern = ".csv")) %>% + setdiff(list.files(path=".", pattern = ".RDS")) %>% + setdiff(list.files(path=".", pattern = ".png")) + ) print("Removed old Report files for fresh start") setwd("..") } @@ -60,7 +63,6 @@ server <- function(input,output,session){ hideTab(inputId = "tabsetPanel1", target = "Sample Correlation") hideTab(inputId = "tabsetPanel1", target = "Significance Analysis") hideTab(inputId = "tabsetPanel1", target = "PCA") - hideTab(inputId = "tabsetPanel1", target = "Volcano Plot") hideTab(inputId = "tabsetPanel1", target = "Heatmap") hideTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations") hideTab(inputId = "tabsetPanel1", target = "Enrichment Analysis") @@ -769,13 +771,6 @@ server <- function(input,output,session){ selected = "PCA") }) observeEvent(input$NextPanel3,{ - updateTabsetPanel( - session = session, - inputId = "tabsetPanel1", - selected = "Volcano Plot" - ) - }) - observeEvent(input$NextPanel4,{ updateTabsetPanel( session = session, inputId = "tabsetPanel1", @@ -961,7 +956,6 @@ server <- function(input,output,session){ showTab(inputId = "tabsetPanel1", target = "Sample Correlation") showTab(inputId = "tabsetPanel1", target = "Significance Analysis") showTab(inputId = "tabsetPanel1", target = "PCA") - showTab(inputId = "tabsetPanel1", target = "Volcano Plot") showTab(inputId = "tabsetPanel1", target = "Heatmap") showTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations") showTab(inputId = "tabsetPanel1", target = "Enrichment Analysis") @@ -973,7 +967,6 @@ server <- function(input,output,session){ shinyjs::click("SignificanceAnalysis-refreshUI",asis = T) shinyjs::click("single_gene_visualisation-refreshUI",asis = T) - shinyjs::click("Volcano-refreshUI",asis = T) paste0(addWarning, "The data has the dimensions of: ", paste0(dim(res_tmp$data),collapse = ", "), @@ -1056,13 +1049,6 @@ server <- function(input,output,session){ reactive(input$row_selection), reactive(updating$count) ) - # Volcano plots ---- - volcano_Server( - id = "Volcano", - data = res_tmp, - params = par_tmp, - reactive(updating$count) - ) # Heatmap ---- heatmap_server( id = 'Heatmap', diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index 90be6d2e..b318cbb2 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -39,6 +39,7 @@ library(kableExtra) library(readxl) library(ggvenn) library(ComplexUpset) +library(gridExtra) # TODO: needs to be added to renv # library(svglite) source("R/C.R") @@ -49,7 +50,6 @@ source("R/module_DownloadReport.R",local=T) source("R/data_selection/ui.R",local=T) source("R/pre_processing/ui.R",local=T) source("R/pca/ui.R",local=T) -source("R/volcano_plot/ui.R",local=T) source("R/heatmap/ui.R",local=T) source("R/single_gene_visualisation/ui.R",local=T) source("R/enrichment_analysis/ui.R",local=T) @@ -189,7 +189,6 @@ ui <- shiny::fluidPage( sample_correlation_panel <- sampleCorrelation_UI("sample_correlation"), significance_analysis_panel <- significance_analysis_UI("SignificanceAnalysis"), pca_panel <- pca_UI("PCA"), - volcano_plot_panel <- volcano_UI("Volcano"), heatmap_panel <- heatmap_UI("Heatmap"), single_gene_visualisation_panel <- single_gene_visualisation_UI("single_gene_visualisation"), enrichment_analysis_tab_panel <- enrichment_analysis_UI("EnrichmentAnalysis")