From 83319aee0d0a6fd0378a8ccbddbec4cd51a08a16 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Sat, 2 Sep 2023 16:25:40 +0200 Subject: [PATCH 01/22] Added checks for workflow to pca and sample correlation. --- program/shinyApp/R/pca/server.R | 36 ++++- program/shinyApp/R/pca/ui.R | 7 +- program/shinyApp/R/pca/util.R | 12 ++ .../shinyApp/R/sample_correlation/server.R | 152 ++++++++++-------- program/shinyApp/R/sample_correlation/ui.R | 1 + 5 files changed, 131 insertions(+), 77 deletions(-) create mode 100644 program/shinyApp/R/pca/util.R 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..18351b40 100644 --- a/program/shinyApp/R/pca/ui.R +++ b/program/shinyApp/R/pca/ui.R @@ -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:", 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/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..d32ab71a 100644 --- a/program/shinyApp/R/sample_correlation/ui.R +++ b/program/shinyApp/R/sample_correlation/ui.R @@ -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( From 27f727818a93ac367ec81c858498559e8cab43d7 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Wed, 6 Sep 2023 09:55:22 +0200 Subject: [PATCH 02/22] Added function to SourceAll.R --- program/shinyApp/R/SourceAll.R | 1 + 1 file changed, 1 insertion(+) diff --git a/program/shinyApp/R/SourceAll.R b/program/shinyApp/R/SourceAll.R index ce4ea3a6..4df04a1a 100644 --- a/program/shinyApp/R/SourceAll.R +++ b/program/shinyApp/R/SourceAll.R @@ -16,6 +16,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/pca/util.R", local = T) source("R/volcano_plot/server.R", local = T) source("R/single_gene_visualisation/server.R",local = T) source("R/sample_correlation/server.R", local = T) From 54a02c00aad77e392ae22867eee33674586ffd98 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Wed, 6 Sep 2023 11:56:09 +0200 Subject: [PATCH 03/22] Added workflow to volcano plot. --- program/shinyApp/R/volcano_plot/server.R | 407 ++++++++++++----------- program/shinyApp/R/volcano_plot/ui.R | 1 + 2 files changed, 219 insertions(+), 189 deletions(-) diff --git a/program/shinyApp/R/volcano_plot/server.R b/program/shinyApp/R/volcano_plot/server.R index 372f153f..849df94e 100644 --- a/program/shinyApp/R/volcano_plot/server.R +++ b/program/shinyApp/R/volcano_plot/server.R @@ -138,6 +138,27 @@ volcano_Server <- function(id, data, params, updates){ input$Do_Volcano[1] >= 1 ) print("Volcano analysis on pre-selected data") + # check whether we have to calculate + check <- check_calculations(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, + "test_method" = input$chooseTest, + "correction_method" = input$chooseTestCorrection + ), "Volcano") + if (check == "No Result yet"){ + output$Volcano_Info <- renderText("PCA computed.") + } else if (check == "Result exists"){ + output$Volcano_Info <- renderText( + "Volcano plot was already computed, no need to click the Button again." + ) + } else if (check == "Overwrite"){ + output$Volcano_Info <- renderText( + "Volcano plot overwritten with different parameters." + ) + } print(input$sample_annotation_types_cmp) ctrl_samples_idx <- which( colData(data$data)[,input$sample_annotation_types_cmp] %in% input$Groups2Compare_ref @@ -159,7 +180,8 @@ volcano_Server <- function(id, data, params, updates){ "Choose another preprocessing, as there are negative values!" ) req(FALSE) - }else{ + } + if(check == "Overwrite" || check == "No Result yet"){ if(params$PreProcessing_Procedure == "ln" | params$PreProcessing_Procedure == "log10" ){ print("Data was logged already => delog, take FC and log ?!") if(params$PreProcessing_Procedure == "ln"){ @@ -176,8 +198,8 @@ volcano_Server <- function(id, data, params, updates){ } print(dim(data2Volcano)) # If "none" for test correction is selected - # we decided to always show a corrected plot - + # we decided to always show a corrected plot + if(input$chooseTestCorrection == "None"){ VolcanoPlot_df_default <- Volcano_Plot( data = data2Volcano, @@ -193,7 +215,7 @@ volcano_Server <- function(id, data, params, updates){ }else{ VolcanoPlot_df_default <- NULL } - + VolcanoPlot_df <- Volcano_Plot( data = data2Volcano, ctrl_samples_idx = ctrl_samples_idx, @@ -205,27 +227,72 @@ volcano_Server <- function(id, data, params, updates){ annotation_add = input$VOLCANO_anno_tooltip, annoData = rowData(data$data) ) - + } + else if (check == "Result exists"){ + VolcanoPlot_df <- res_tmp[["Volcano"]]$df + VolcanoPlot_df_default <- res_tmp[["Volcano"]]$df_default + } - # 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) + # assign res_temp + res_tmp[["Volcano"]]$df <<- VolcanoPlot_df + res_tmp[["Volcano"]]$df_default <<- VolcanoPlot_df_default + # 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, + "test_method" = input$chooseTest, + "correction_method" = input$chooseTestCorrection + ) + 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), @@ -234,202 +301,164 @@ volcano_Server <- function(id, data, params, updates){ 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")) + theme(legend.position = "none")+ + ggtitle("BH-corrected p-Vals on y Axis") + + plotPosition <- "Volcano_Plot_final_default" - plotPosition <- "Volcano_Plot_final" - scenario <- 9 - scenario_Volcano <- scenario output[[plotPosition]] <- renderPlotly({ggplotly( - VolcanoPlot, + VolcanoPlot_default, 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 - } + }else{ + plotPosition <- "Volcano_Plot_final_default" - # 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[[plotPosition]] <- NULL + } - 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 + # 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 ) - }, - contentType = "application/zip" - ) - output$SavePlot_Volcano <- downloadHandler( - filename = function() { paste("VOLCANO_",Sys.time(),input$file_ext_Volcano,sep="") }, - content = function(file){ + 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 = file, + filename = tmp_filename, 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 - ) - }) - } - ) + # 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,")")) - 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=input$lfc_threshold) ) - } + DE_DOWN <- subset( + volcano_reactive$LFCTable, + subset = p_adj Date: Thu, 7 Sep 2023 13:32:59 +0200 Subject: [PATCH 04/22] Added workflow to heatmap plot. --- program/shinyApp/R/heatmap/server.R | 262 +++++++++++++++-------- program/shinyApp/R/heatmap/ui.R | 1 + program/shinyApp/R/volcano_plot/server.R | 2 +- 3 files changed, 176 insertions(+), 89 deletions(-) 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..0453ce41 100644 --- a/program/shinyApp/R/heatmap/ui.R +++ b/program/shinyApp/R/heatmap/ui.R @@ -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( diff --git a/program/shinyApp/R/volcano_plot/server.R b/program/shinyApp/R/volcano_plot/server.R index 849df94e..150916e1 100644 --- a/program/shinyApp/R/volcano_plot/server.R +++ b/program/shinyApp/R/volcano_plot/server.R @@ -149,7 +149,7 @@ volcano_Server <- function(id, data, params, updates){ "correction_method" = input$chooseTestCorrection ), "Volcano") if (check == "No Result yet"){ - output$Volcano_Info <- renderText("PCA computed.") + output$Volcano_Info <- renderText("Volcano Plot computed.") } else if (check == "Result exists"){ output$Volcano_Info <- renderText( "Volcano plot was already computed, no need to click the Button again." From 901f74b25510187f852d394539b991ac10af3e1c Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 15 Sep 2023 15:52:31 +0200 Subject: [PATCH 05/22] Added workflow to significance analysis and res_tmp/par_tmp. --- program/shinyApp/R/significance_analysis/server.R | 15 +++++++++++++++ program/shinyApp/R/significance_analysis/util.R | 15 +++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/program/shinyApp/R/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index 557d94a5..b14de634 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` } } diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index da598f40..ae4d0f68 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -248,6 +248,15 @@ 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]]] + 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]) @@ -267,6 +276,12 @@ significance_analysis <- function( stringsAsFactors = FALSE ) 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) From 06626c7b6879de4121d7fa7c99ae574b8b8c49e0 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 15 Sep 2023 20:11:25 +0200 Subject: [PATCH 06/22] Added workflow to enrichment analysis and res_tmp/par_tmp. --- .../enrichment_analysis/enrichment_analysis.R | 986 +++++++++++------- .../shinyApp/R/enrichment_analysis/server.R | 9 +- 2 files changed, 618 insertions(+), 377 deletions(-) diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R index 49d1a6c3..27814188 100644 --- a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R @@ -1,16 +1,19 @@ 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 +47,690 @@ 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),res_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),res_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{ + browser() + 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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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),res_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/server.R b/program/shinyApp/R/enrichment_analysis/server.R index c2095747..b70df9a1 100644 --- a/program/shinyApp/R/enrichment_analysis/server.R +++ b/program/shinyApp/R/enrichment_analysis/server.R @@ -705,6 +705,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){ observeEvent(input$enrichmentGO,{ ea_reactives$ea_info <- "Enrichment is running..." print("Start Enrichment") + browser() fun_LogIt("## ENRICHMENT") req(geneSetChoice()) ea_reactives$tmp_genes <- geneSetChoice() @@ -769,12 +770,14 @@ enrichment_analysis_Server <- function(id, data, params, updates){ req(ea_reactives$can_start == TRUE) 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( From 9a510c4012cb58bb82315b6bfc515371a0c291b8 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 15 Sep 2023 20:32:28 +0200 Subject: [PATCH 07/22] Fixed spelling --- .../enrichment_analysis/enrichment_analysis.R | 60 +++++++++---------- .../shinyApp/R/enrichment_analysis/server.R | 2 +- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R index 27814188..32a7a091 100644 --- a/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R +++ b/program/shinyApp/R/enrichment_analysis/enrichment_analysis.R @@ -1,4 +1,5 @@ gene_set_enrichment <- function( + input, geneSetChoice, data, enrichments2do, @@ -48,7 +49,7 @@ gene_set_enrichment <- function( if(enrichments2do$KEGG){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$KEGG )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$KEGG )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -71,7 +72,7 @@ gene_set_enrichment <- function( } if(enrichments2do$GO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$GO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GO )) ){ EnrichmentRes_GO <- clusterProfiler::gseGO( gene = geneSetChoice, @@ -87,14 +88,13 @@ gene_set_enrichment <- function( res_tmp$EA[[comp_type]][[contrast]]$GO <<- EnrichmentRes_GO par_tmp$EA[[comp_type]][[contrast]]$GO <<- list("adjustMethod"=adjustMethod, "sort"=sorting) }else{ - browser() EnrichmentRes_GO <- res_tmp$EA[[comp_type]][[contrast]]$GO } } # Hallmarks if(enrichments2do$Hallmarks){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$Hallmarks )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$Hallmarks )) ){ Hallmarkset <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -117,7 +117,7 @@ gene_set_enrichment <- function( # C1 if(enrichments2do$C1){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C1 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C1 )) ){ C1set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -141,7 +141,7 @@ gene_set_enrichment <- function( # C2 if(enrichments2do$C2){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C2 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C2 )) ){ C2set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -164,7 +164,7 @@ gene_set_enrichment <- function( # C3 if(enrichments2do$C3){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C3 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C3 )) ){ C3set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -187,7 +187,7 @@ gene_set_enrichment <- function( # C4 if(enrichments2do$C4){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C4 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C4 )) ){ C4set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -210,7 +210,7 @@ gene_set_enrichment <- function( # C5 if(enrichments2do$C5){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C5 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C5 )) ){ C5set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -233,7 +233,7 @@ gene_set_enrichment <- function( # C6 if(enrichments2do$C6){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C6 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C6 )) ){ C6set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -256,7 +256,7 @@ gene_set_enrichment <- function( # C7 if(enrichments2do$C7){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C7 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C7 )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -279,7 +279,7 @@ gene_set_enrichment <- function( # C8 if(enrichments2do$C8){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$C8 )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$C8 )) ){ C8set <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -302,7 +302,7 @@ gene_set_enrichment <- function( # C2 subset CGP if(enrichments2do$CGP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$CGP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -326,7 +326,7 @@ gene_set_enrichment <- function( # C2 subset CP if(enrichments2do$CP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$CP )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CP )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -350,7 +350,7 @@ gene_set_enrichment <- function( # C2:CP subset BIOCARTA if(enrichments2do$BIOCARTA){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$BIOCARTA )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$BIOCARTA )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -374,7 +374,7 @@ gene_set_enrichment <- function( # C2:CP subset PID if(enrichments2do$PID){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$PID )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$PID )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -398,7 +398,7 @@ gene_set_enrichment <- function( # C2:CP subset REACTOME if(enrichments2do$REACTOME){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$REACTOME )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$REACTOME )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -422,7 +422,7 @@ gene_set_enrichment <- function( # C2:CP subset WIKIPATHWAYS if(enrichments2do$WIKIPATHWAYS){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$WIKIPATHWAYS )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -446,7 +446,7 @@ gene_set_enrichment <- function( # C3 subset MIR:MIRDB if(enrichments2do$MIRDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$MIRDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$MIRDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -470,7 +470,7 @@ gene_set_enrichment <- function( # C3 subset MIR:MIR_Legacy if(enrichments2do$MIR_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$MIR_Legacy )) + !(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"), @@ -494,7 +494,7 @@ gene_set_enrichment <- function( # C3 subset TFT:GTRD if(enrichments2do$GTRD){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$GTRD )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$GTRD )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -518,7 +518,7 @@ gene_set_enrichment <- function( # C3 subset TFT:TFT_Legacy if(enrichments2do$TFT_Legacy){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$TFT_Legacy )) + !(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"), @@ -542,7 +542,7 @@ gene_set_enrichment <- function( # C4 subset CGN if(enrichments2do$CGN){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$CGN )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CGN )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -566,7 +566,7 @@ gene_set_enrichment <- function( # C4 subset CM if(enrichments2do$CM){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$CM )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$CM )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -590,7 +590,7 @@ gene_set_enrichment <- function( # C5 subset GO BP if(enrichments2do$GO_BP){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$GO_BP )) + !(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"), @@ -614,7 +614,7 @@ gene_set_enrichment <- function( # C5 subset GO CC if(enrichments2do$GO_CC){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$GO_CC )) + !(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"), @@ -638,7 +638,7 @@ gene_set_enrichment <- function( # C5 subset GO MF if(enrichments2do$GO_MF){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$GO_MF )) + !(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"), @@ -662,7 +662,7 @@ gene_set_enrichment <- function( # C5 subset HPO if(enrichments2do$HPO){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$HPO )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$HPO )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -686,7 +686,7 @@ gene_set_enrichment <- function( # C7 subset IMMUNESIGDB if(enrichments2do$IMMUNESIGDB){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$IMMUNESIGDB )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), @@ -710,7 +710,7 @@ gene_set_enrichment <- function( # C7 subset VAX if(enrichments2do$VAX){ if( - !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),res_tmp$EA[[comp_type]][[contrast]]$VAX )) + !(identical(list("adjustMethod"=adjustMethod, "sort"=sorting),par_tmp$EA[[comp_type]][[contrast]]$VAX )) ){ genesets4ea <- msigdbr( species = ifelse(input$OrganismChoice == "hsa","Homo sapiens","Mus musculus"), diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R index b70df9a1..58b8d499 100644 --- a/program/shinyApp/R/enrichment_analysis/server.R +++ b/program/shinyApp/R/enrichment_analysis/server.R @@ -705,7 +705,6 @@ enrichment_analysis_Server <- function(id, data, params, updates){ observeEvent(input$enrichmentGO,{ ea_reactives$ea_info <- "Enrichment is running..." print("Start Enrichment") - browser() fun_LogIt("## ENRICHMENT") req(geneSetChoice()) ea_reactives$tmp_genes <- geneSetChoice() @@ -770,6 +769,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){ req(ea_reactives$can_start == TRUE) if(input$ORA_or_GSE == "GeneSetEnrichment"){ ea_reactives$enrichment_results <- gene_set_enrichment( + input, ea_reactives$tmp_genes, data$data, ea_reactives$enrichments2do, From 23a59194872b73bb773b3c634dda2c8f51aa0644 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 15 Sep 2023 21:25:45 +0200 Subject: [PATCH 08/22] OA Workflow and res/par_tmp --- .../overrepresentation_analysis.R | 854 +++++++++++------- 1 file changed, 517 insertions(+), 337 deletions(-) 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, From d6f837df138a8ccd57c22f9e96dc1bcf98cc8e07 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Mon, 18 Sep 2023 17:41:33 +0200 Subject: [PATCH 09/22] Displaying mre information on sigAna table --- program/shinyApp/R/fun_volcano.R | 2 +- .../shinyApp/R/significance_analysis/util.R | 24 +++++++++++-------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/program/shinyApp/R/fun_volcano.R b/program/shinyApp/R/fun_volcano.R index 7f5dcf30..2b92404b 100644 --- a/program/shinyApp/R/fun_volcano.R +++ b/program/shinyApp/R/fun_volcano.R @@ -71,7 +71,7 @@ Volcano_Plot <- function( Ctrl_mean <- apply(df[,ctrl_samples_idx],1,mean) # check whether there are 0's in Ctrl mean - if(any(Ctrl_mean < 0)){ + if(any(Ctrl_mean <= 0)){ warning("NAs will be produced due to impossible division by 0") } diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index ae4d0f68..026e5c03 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -87,7 +87,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,7 +95,7 @@ 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(1, 'asc')), # 2=padj, 1=pvalue dom = 'Bfrtip', lengthMenu = c(10, 25, 50, 100, -1), buttons = c('pageLength', 'copy', 'csv', 'excel') @@ -228,7 +228,11 @@ significance_analysis <- function( tryCatch( { results <- test_function(x, y) - return(results$p.value) + return(list( + "pvalue" = results$p.value, + "baseMean" = results$estimate[[2]], + "stat" = results$statistic + )) }, error = function(e) { cat( @@ -255,6 +259,7 @@ significance_analysis <- function( )){ 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 @@ -268,13 +273,13 @@ significance_analysis <- function( grp1 = idx, grp2 = idy ) + res <- as.data.frame(do.call(rbind, res)) # create a dataframe with the results - res <- data.frame( - gene = rownames(df), - pvalue = res, - padj = p.adjust(res, method = correction), - stringsAsFactors = FALSE - ) + res$padj <- p.adjust(res$pvalue, method = correction) + res <- transform(res, pvalue=as.numeric(pvalue), + baseMean=as.numeric(baseMean), stat=as.numeric(stat)) + browser() + sig_results[[names(contrasts)[comp_name]]] <- res # fill res_tmp, par_tmp res_tmp$SigAna[[contrast_level]][[names(contrasts)[comp_name]]] <<- res @@ -282,7 +287,6 @@ significance_analysis <- function( test_method = method, test_correction = correction ) - comp_name <- comp_name + 1 } return(sig_results) } From 01f4c0c6788d56e3cce2b5cc9306943aa7aad6a3 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Thu, 21 Sep 2023 12:46:13 +0200 Subject: [PATCH 10/22] Calculating log2Foldchanges, table very similar to DESeq Table --- .../shinyApp/R/significance_analysis/util.R | 60 ++++++++++++++++++- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 026e5c03..59d9c059 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -95,7 +95,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n fixedColumns = TRUE, autoWidth = TRUE, ordering = TRUE, - # order = list(list(4, 'asc'), list(1, 'asc')), # 2=padj, 1=pvalue + order = list(list(4, 'asc'), list(5, 'asc')), # 2=padj, 1=pvalue dom = 'Bfrtip', lengthMenu = c(10, 25, 50, 100, -1), buttons = c('pageLength', 'copy', 'csv', 'excel') @@ -231,6 +231,7 @@ significance_analysis <- function( return(list( "pvalue" = results$p.value, "baseMean" = results$estimate[[2]], + "treatMean" = results$estimate[[1]], "stat" = results$statistic )) }, @@ -274,11 +275,24 @@ significance_analysis <- function( grp2 = idy ) 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)) - browser() + + sig_results[[names(contrasts)[comp_name]]] <- res # fill res_tmp, par_tmp @@ -320,3 +334,45 @@ 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." + ) + } + 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) + } +} From dc1dca2921ed591380aad2eac97fc75092573a46 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Thu, 21 Sep 2023 14:25:20 +0200 Subject: [PATCH 11/22] Added panel for volcano plot --- .../shinyApp/R/significance_analysis/util.R | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 59d9c059..3a43a784 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -71,11 +71,20 @@ 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" + ) + ) ) ) # server part of tabPanel From 30ea0a82fc2357114a3a1283720bcfb55f5b2e9c Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 22 Sep 2023 19:58:01 +0200 Subject: [PATCH 12/22] only filter volcano wokrs, both to report and saving plots works. --- .../shinyApp/R/significance_analysis/util.R | 300 +++++++++++++++++- 1 file changed, 298 insertions(+), 2 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 3a43a784..ff28c095 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -82,13 +82,118 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n DT::dataTableOutput(outputId = ns(paste(contrast[1], contrast[2], "table", sep = "_"))) ), tabPanel( - title = "Volcano" + title = "Volcano", + splitLayout( + style = "border: 1px solid silver:", + cellWidths = c("70%", "30%"), + 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 - # 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 = "
") ) @@ -111,6 +216,168 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n ), 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 + browser() + 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)") + + 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="") + + theme(legend.position = "none") + + 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) + }) + }) + } @@ -310,6 +577,7 @@ significance_analysis <- function( test_method = method, test_correction = correction ) + comp_name <- comp_name + 1 } return(sig_results) } @@ -385,3 +653,31 @@ getLFC <- function(means){ 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) +} From 0761a74ce47bbf605b4d479a645fa3a7716c2832 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 22 Sep 2023 20:01:25 +0200 Subject: [PATCH 13/22] Small change, s.t. legend is on the left side now. --- program/shinyApp/R/significance_analysis/util.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index ff28c095..046702fb 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -85,7 +85,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n title = "Volcano", splitLayout( style = "border: 1px solid silver:", - cellWidths = c("70%", "30%"), + cellWidths = c("40%", "60%"), plotlyOutput( outputId = ns(paste(contrast[1], contrast[2], "Volcano", sep = "_")) ) %>% withSpinner(type = 8), @@ -299,6 +299,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n 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, @@ -321,7 +322,8 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n color="lightgrey" ) + scale_color_manual(values=colorScheme2, name="") + - theme(legend.position = "none") + + 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, From 8dea1b62928079c013a04068b9aeb4b8d312b6cc Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 22 Sep 2023 20:08:20 +0200 Subject: [PATCH 14/22] Working for log transform now as well --- program/shinyApp/R/significance_analysis/util.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 046702fb..2a029301 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -256,7 +256,6 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n sig_ana_reactive$th_lfc <- ifelse(is.null(input[[lfc_th]]), 1, input[[lfc_th]]) # plot volcano plot data4Volcano <- result - browser() 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") @@ -646,6 +645,7 @@ getLFC <- function(means){ 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) From 0dfda2971766eaf10ed391b1cb28ccd8504cd018 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Sun, 24 Sep 2023 13:43:48 +0200 Subject: [PATCH 15/22] Working for DESeq data as well. --- .../shinyApp/R/significance_analysis/util.R | 286 +++++++++++++++++- 1 file changed, 281 insertions(+), 5 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 2a029301..fab3ba5a 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -438,14 +438,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 = "
") @@ -469,6 +583,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) + }) + }) } From a03a95bad8aaf0f280174870872496d444c1ce73 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Sun, 24 Sep 2023 13:46:30 +0200 Subject: [PATCH 16/22] Added gridExtra as dependencie. Needs to be put into renv as well. --- program/shinyApp/ui.R | 1 + 1 file changed, 1 insertion(+) diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index acf5d94b..6fd80a8e 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -37,6 +37,7 @@ library(msigdbr) library(tidyr) library(kableExtra) library(readxl) +# library(gridExtra) # TODO: needs to be added to renv # library(svglite) source("R/C.R") From 2caa4d6282f4d16994a1933d02a5ac09ecd23f1d Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Sun, 24 Sep 2023 13:52:16 +0200 Subject: [PATCH 17/22] Removed volcano plot panel. Do we need to rename "significance Analysis" or add an info pop up? --- program/shinyApp/R/SourceAll.R | 2 - program/shinyApp/R/fun_volcano.R | 105 ----- program/shinyApp/R/volcano_plot/server.R | 514 ----------------------- program/shinyApp/R/volcano_plot/ui.R | 134 ------ program/shinyApp/server.R | 17 - program/shinyApp/ui.R | 2 - 6 files changed, 774 deletions(-) delete mode 100644 program/shinyApp/R/fun_volcano.R delete mode 100644 program/shinyApp/R/volcano_plot/server.R delete mode 100644 program/shinyApp/R/volcano_plot/ui.R diff --git a/program/shinyApp/R/SourceAll.R b/program/shinyApp/R/SourceAll.R index 4df04a1a..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) @@ -17,7 +16,6 @@ source("R/enrichment_analysis/server.R", local = T) source("R/heatmap/server.R",local = T) source("R/pca/server.R", local = T) source("R/pca/util.R", local = T) -source("R/volcano_plot/server.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/fun_volcano.R b/program/shinyApp/R/fun_volcano.R deleted file mode 100644 index 2b92404b..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/volcano_plot/server.R b/program/shinyApp/R/volcano_plot/server.R deleted file mode 100644 index 150916e1..00000000 --- a/program/shinyApp/R/volcano_plot/server.R +++ /dev/null @@ -1,514 +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") - # check whether we have to calculate - check <- check_calculations(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, - "test_method" = input$chooseTest, - "correction_method" = input$chooseTestCorrection - ), "Volcano") - if (check == "No Result yet"){ - output$Volcano_Info <- renderText("Volcano Plot computed.") - } else if (check == "Result exists"){ - output$Volcano_Info <- renderText( - "Volcano plot was already computed, no need to click the Button again." - ) - } else if (check == "Overwrite"){ - output$Volcano_Info <- renderText( - "Volcano plot overwritten with different parameters." - ) - } - 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) - } - if(check == "Overwrite" || check == "No Result yet"){ - 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) - ) - } - else if (check == "Result exists"){ - VolcanoPlot_df <- res_tmp[["Volcano"]]$df - VolcanoPlot_df_default <- res_tmp[["Volcano"]]$df_default - } - - - # assign res_temp - res_tmp[["Volcano"]]$df <<- VolcanoPlot_df - res_tmp[["Volcano"]]$df_default <<- VolcanoPlot_df_default - # 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, - "test_method" = input$chooseTest, - "correction_method" = input$chooseTestCorrection - ) - 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/server.R b/program/shinyApp/server.R index 7b0625f2..079feab2 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -60,7 +60,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 +768,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 +953,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 +964,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 +1046,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 6fd80a8e..242d4f30 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -48,7 +48,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) @@ -181,7 +180,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") From 2d1e4fc1a2c4531309a7ee328a1a747e5d948130 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 29 Sep 2023 09:51:35 +0200 Subject: [PATCH 18/22] Fixed UpsetPlots --- .../shinyApp/R/enrichment_analysis/server.R | 2 +- program/shinyApp/R/fun_LFC.R | 2 +- .../shinyApp/R/significance_analysis/server.R | 27 ++++++------------- 3 files changed, 10 insertions(+), 21 deletions(-) diff --git a/program/shinyApp/R/enrichment_analysis/server.R b/program/shinyApp/R/enrichment_analysis/server.R index 58b8d499..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 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/significance_analysis/server.R b/program/shinyApp/R/significance_analysis/server.R index b14de634..8a72aad8 100644 --- a/program/shinyApp/R/significance_analysis/server.R +++ b/program/shinyApp/R/significance_analysis/server.R @@ -350,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 @@ -388,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) From 90c2222fa2b393fbd5f525cf21ef89642e049bb5 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Fri, 29 Sep 2023 09:56:41 +0200 Subject: [PATCH 19/22] Set up Infrastructure for helpfiles --- program/shinyApp/R/data_selection/ui.R | 20 +++++++++---------- program/shinyApp/R/enrichment_analysis/ui.R | 6 +++--- program/shinyApp/R/heatmap/ui.R | 10 +++++----- program/shinyApp/R/pca/ui.R | 14 ++++++------- program/shinyApp/R/pre_processing/ui.R | 8 ++++---- program/shinyApp/R/sample_correlation/ui.R | 4 ++-- program/shinyApp/R/significance_analysis/ui.R | 12 ++++++++--- .../shinyApp/R/significance_analysis/util.R | 2 +- .../shinyApp/R/single_gene_visualisation/ui.R | 8 ++++---- .../DataSelection_DataUploadFileInput.md | 6 ++++++ .../helpfiles/DataSelection_Matrix.md | 6 ++++++ .../helpfiles/DataSelection_MetaData.md | 6 ++++++ .../shinyApp/helpfiles/DataSelection_Reset.md | 6 ++++++ .../helpfiles/DataSelection_RowAnno.md | 6 ++++++ .../helpfiles/DataSelection_RowSelection.md | 6 ++++++ .../helpfiles/DataSelection_SampleAnno.md | 6 ++++++ .../helpfiles/DataSelection_SummarizedExp.md | 6 ++++++ .../DataSelection_UploadInspection.md | 6 ++++++ .../DataSelection_compilation_help.md | 6 ++++++ .../helpfiles/DataSeletcion_MetaData.md | 6 ++++++ .../shinyApp/helpfiles/DataSeletcion_Reset.md | 1 + program/shinyApp/helpfiles/EA_Download.md | 6 ++++++ program/shinyApp/helpfiles/EA_GeneSets.md | 6 ++++++ program/shinyApp/helpfiles/EA_Options.md | 6 ++++++ .../shinyApp/helpfiles/Heatmap_Aesthetics.md | 6 ++++++ .../shinyApp/helpfiles/Heatmap_Download.md | 6 ++++++ .../helpfiles/Heatmap_FurtherOptions.md | 6 ++++++ program/shinyApp/helpfiles/Heatmap_Options.md | 6 ++++++ .../helpfiles/Heatmap_RowAnnoBased.md | 6 ++++++ program/shinyApp/helpfiles/PCA_Choices.md | 6 ++++++ program/shinyApp/helpfiles/PCA_Downloads.md | 6 ++++++ .../helpfiles/PCA_LoadingsDownload.md | 6 ++++++ .../helpfiles/PCA_LoadingsMatrixDownload.md | 6 ++++++ .../shinyApp/helpfiles/PCA_ScreeDownload.md | 6 ++++++ program/shinyApp/helpfiles/PCA_Tabpanels.md | 6 ++++++ .../helpfiles/PreProcessing_DESeqMain.md | 6 ++++++ .../helpfiles/PreProcessing_DESeqSub.md | 6 ++++++ .../helpfiles/PreProcessing_Procedures.md | 6 ++++++ .../shinyApp/helpfiles/SampleCorr_Choices.md | 6 ++++++ .../helpfiles/SampleCorr_Downloads.md | 6 ++++++ program/shinyApp/helpfiles/SigAna_Choices.md | 6 ++++++ .../shinyApp/helpfiles/SigAna_Downloads.md | 6 ++++++ .../helpfiles/SigAna_Intersections.md | 6 ++++++ program/shinyApp/helpfiles/SigAna_Vis.md | 6 ++++++ .../helpfiles/SigAna_VolcanoDownloads.md | 6 ++++++ .../helpfiles/SingleGene_Comparisons.md | 6 ++++++ .../shinyApp/helpfiles/SingleGene_Download.md | 6 ++++++ .../shinyApp/helpfiles/SingleGene_Options.md | 6 ++++++ .../shinyApp/helpfiles/SingleGene_Select.md | 6 ++++++ 49 files changed, 280 insertions(+), 39 deletions(-) create mode 100644 program/shinyApp/helpfiles/DataSelection_DataUploadFileInput.md create mode 100644 program/shinyApp/helpfiles/DataSelection_Matrix.md create mode 100644 program/shinyApp/helpfiles/DataSelection_MetaData.md create mode 100644 program/shinyApp/helpfiles/DataSelection_Reset.md create mode 100644 program/shinyApp/helpfiles/DataSelection_RowAnno.md create mode 100644 program/shinyApp/helpfiles/DataSelection_RowSelection.md create mode 100644 program/shinyApp/helpfiles/DataSelection_SampleAnno.md create mode 100644 program/shinyApp/helpfiles/DataSelection_SummarizedExp.md create mode 100644 program/shinyApp/helpfiles/DataSelection_UploadInspection.md create mode 100644 program/shinyApp/helpfiles/DataSelection_compilation_help.md create mode 100644 program/shinyApp/helpfiles/DataSeletcion_MetaData.md create mode 100644 program/shinyApp/helpfiles/DataSeletcion_Reset.md create mode 100644 program/shinyApp/helpfiles/EA_Download.md create mode 100644 program/shinyApp/helpfiles/EA_GeneSets.md create mode 100644 program/shinyApp/helpfiles/EA_Options.md create mode 100644 program/shinyApp/helpfiles/Heatmap_Aesthetics.md create mode 100644 program/shinyApp/helpfiles/Heatmap_Download.md create mode 100644 program/shinyApp/helpfiles/Heatmap_FurtherOptions.md create mode 100644 program/shinyApp/helpfiles/Heatmap_Options.md create mode 100644 program/shinyApp/helpfiles/Heatmap_RowAnnoBased.md create mode 100644 program/shinyApp/helpfiles/PCA_Choices.md create mode 100644 program/shinyApp/helpfiles/PCA_Downloads.md create mode 100644 program/shinyApp/helpfiles/PCA_LoadingsDownload.md create mode 100644 program/shinyApp/helpfiles/PCA_LoadingsMatrixDownload.md create mode 100644 program/shinyApp/helpfiles/PCA_ScreeDownload.md create mode 100644 program/shinyApp/helpfiles/PCA_Tabpanels.md create mode 100644 program/shinyApp/helpfiles/PreProcessing_DESeqMain.md create mode 100644 program/shinyApp/helpfiles/PreProcessing_DESeqSub.md create mode 100644 program/shinyApp/helpfiles/PreProcessing_Procedures.md create mode 100644 program/shinyApp/helpfiles/SampleCorr_Choices.md create mode 100644 program/shinyApp/helpfiles/SampleCorr_Downloads.md create mode 100644 program/shinyApp/helpfiles/SigAna_Choices.md create mode 100644 program/shinyApp/helpfiles/SigAna_Downloads.md create mode 100644 program/shinyApp/helpfiles/SigAna_Intersections.md create mode 100644 program/shinyApp/helpfiles/SigAna_Vis.md create mode 100644 program/shinyApp/helpfiles/SigAna_VolcanoDownloads.md create mode 100644 program/shinyApp/helpfiles/SingleGene_Comparisons.md create mode 100644 program/shinyApp/helpfiles/SingleGene_Download.md create mode 100644 program/shinyApp/helpfiles/SingleGene_Options.md create mode 100644 program/shinyApp/helpfiles/SingleGene_Select.md 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/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/heatmap/ui.R b/program/shinyApp/R/heatmap/ui.R index 0453ce41..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"), @@ -83,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/ui.R b/program/shinyApp/R/pca/ui.R index 18351b40..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"), @@ -41,7 +41,7 @@ pca_main_panel <- function(ns){ tabPanel( title = "PCA_plot", textOutput(outputId = ns("PCA_Info"), container = pre), - plotlyOutput(outputId = ns("PCA_plot")) , + plotlyOutput(outputId = ns("PCA_plot")), uiOutput(outputId = ns("PCA_anno_tooltip_ui")), splitLayout( style = "border: 1px solid silver:", @@ -50,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:", @@ -124,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:", @@ -186,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:", @@ -236,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:", @@ -269,7 +269,7 @@ pca_main_panel <- function(ns){ selected = ".png" ) ) - ) + ) # %>% helper(type = "markdown", content = "PCA_Tabpanels") ) ) } 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/ui.R b/program/shinyApp/R/sample_correlation/ui.R index d32ab71a..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", @@ -38,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/ui.R b/program/shinyApp/R/significance_analysis/ui.R index 2f7d4a39..977fd45b 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 @@ -29,7 +30,7 @@ significance_analysis_sidebar_ui<- function(ns){ significance_analysis_main_ui <- function(ns){ mainPanel( id = "main_significance_analysis", - # informative text, whether analysis was done or not + # informative text, whether ana lysis was done or not htmlOutput(outputId = ns("significance_analysis_info"), container = pre), tabsetPanel( id = ns("significance_analysis_results"), @@ -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 fab3ba5a..42c35f5f 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -100,7 +100,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n style = "border: 1px solid silver:", cellWidths = c("35%","35%", "30%"), h5("Volcano plot padj"), - h5("Both Volcano plots"), + h5("Both Volcano plots") %>% helper(type = "markdown", content = "SigAna_VolcanoDownloads"), h5("Volcano plot pvalue") ), splitLayout( 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/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 + From 4a664ab8c3a483040cdea0d28470ccb8cc335c11 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Thu, 5 Oct 2023 09:50:04 -0400 Subject: [PATCH 20/22] Made gridExtra as an import library. --- program/shinyApp/ui.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index 242d4f30..38f64e10 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -37,7 +37,7 @@ library(msigdbr) library(tidyr) library(kableExtra) library(readxl) -# library(gridExtra) # TODO: needs to be added to renv +library(gridExtra) # TODO: needs to be added to renv # library(svglite) source("R/C.R") From fa455760469c8102b98196731882fc08ca02d607 Mon Sep 17 00:00:00 2001 From: PaulJonasJost Date: Thu, 5 Oct 2023 10:08:44 -0400 Subject: [PATCH 21/22] not deleting png out of www --- program/shinyApp/server.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index 079feab2..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("..") } From d98116cba59a31489f3d7a70a5d250f81956e1a6 Mon Sep 17 00:00:00 2001 From: Paul Jonas Jost <70631928+PaulJonasJost@users.noreply.github.com> Date: Mon, 11 Dec 2023 14:00:21 +0100 Subject: [PATCH 22/22] Apply suggestions from code review Co-authored-by: Lea Seep <74967328+LeaSeep@users.noreply.github.com> --- program/shinyApp/R/significance_analysis/ui.R | 2 +- program/shinyApp/R/significance_analysis/util.R | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/program/shinyApp/R/significance_analysis/ui.R b/program/shinyApp/R/significance_analysis/ui.R index 977fd45b..2289d247 100644 --- a/program/shinyApp/R/significance_analysis/ui.R +++ b/program/shinyApp/R/significance_analysis/ui.R @@ -30,7 +30,7 @@ significance_analysis_sidebar_ui<- function(ns){ significance_analysis_main_ui <- function(ns){ mainPanel( id = "main_significance_analysis", - # informative text, whether ana lysis was done or not + # informative text, whether analysis was done or not htmlOutput(outputId = ns("significance_analysis_info"), container = pre), tabsetPanel( id = ns("significance_analysis_results"), diff --git a/program/shinyApp/R/significance_analysis/util.R b/program/shinyApp/R/significance_analysis/util.R index 42c35f5f..69e62c1e 100644 --- a/program/shinyApp/R/significance_analysis/util.R +++ b/program/shinyApp/R/significance_analysis/util.R @@ -209,7 +209,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n fixedColumns = TRUE, autoWidth = TRUE, ordering = TRUE, - order = list(list(4, 'asc'), list(5, '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') @@ -297,8 +297,9 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n ) + scale_color_manual(values=colorScheme2, name="") + xlab("Log FoldChange") + - ylab("-log10(p-value)") + + 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, @@ -323,6 +324,7 @@ create_new_tab_manual <- function(title, targetPanel, result, contrast, alpha, n 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,