From c337389dd80244e3fa637a5f2cbdd54ae0f28328 Mon Sep 17 00:00:00 2001 From: Michael Scherer Date: Tue, 12 May 2020 14:50:11 +0200 Subject: [PATCH 1/4] Added functions for annnotation enrichment --- R/server_output.R | 11 ++++++- R/server_output_meta.R | 22 ++++++++++--- R/server_plot.R | 12 +++++-- R/server_table.R | 73 ++++++++++++++++++++++++++++++++++++++++++ R/ui_meta_analysis.R | 29 ++++++++++++----- 5 files changed, 131 insertions(+), 16 deletions(-) diff --git a/R/server_output.R b/R/server_output.R index 5290d3f..6d28ec0 100644 --- a/R/server_output.R +++ b/R/server_output.R @@ -262,7 +262,16 @@ server_output <- function(input, output, server_env) { DT::dataTableOutput('lolaEnrichementTable') ) - }else{ + }else if (input$diffOutputType == "Annotation Enrichments") { + list(plotOutput("metaPlot"), + if(!all(is.na(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]]))){ + downloadLink("metaPlotPDF", "Annotation Plot PDF") + }else{ + br() + }, + DT::dataTableOutput('annotationEnrichementTable') + ) + }else{ br() } } else if(input$analysisType=="Trait Association"){ diff --git a/R/server_output_meta.R b/R/server_output_meta.R index 681035c..602893c 100644 --- a/R/server_output_meta.R +++ b/R/server_output_meta.R @@ -122,10 +122,10 @@ server_output_meta <- function(input, output, server_env) { }) output$assemblySelector <- renderUI({ - result<-server_env$dataset() - if(!is.null(result@parameters$ASSEMBLY)){ - assembly<-result@parameters$ASSEMBLY - } +# result<-server_env$dataset() +# if(!is.null(result@parameters$ASSEMBLY)){ +# assembly<-result@parameters$ASSEMBLY +# } assembly<-"hg38" assemblies<-list() assemblies[["hg38"]]<-1 @@ -145,6 +145,12 @@ output$lmclolaSelector<-renderUI({ server_env$getLOLAEnrichmenttable() server_env$lmclolaSelect() }) + +output$lmcannotationSelector<-renderUI({ + server_env$getAnnotationEnrichmenttable() + server_env$lmcannotationSelect() +}) + output$analyType<-renderUI({ atype<-c() if(!is.null(medecom_ref_object)){ @@ -211,4 +217,12 @@ output$analyType<-renderUI({ selectInput("lmcs_6_2", "Select LMC to compare", Ks, multiple = F, selected=Ks[[2]]) ) }) + + output$lmcs_selector_annotation<-renderUI({ + Ks <- 1:server_env$Selected$K + list( + selectInput("lmcs_6_1", "Select LMC to compare", Ks, multiple = F, selected=Ks[[1]]), + selectInput("lmcs_6_2", "Select LMC to compare", Ks, multiple = F, selected=Ks[[2]]) + ) + }) } diff --git a/R/server_plot.R b/R/server_plot.R index 6c37aff..6f917d3 100644 --- a/R/server_plot.R +++ b/R/server_plot.R @@ -535,16 +535,22 @@ server_env$doMetaPlot<-function(){ if(!is.na(server_env$getGOEnrichmenttable()[[input$lmc_go]])){ MeDeCom:::do.go.plot(server_env$getGOEnrichmenttable()[[input$lmc_go]], pvalCut=input$pValcut) } - } + } }else if(input$diffOutputType == "LOLA Enrichments"){ server_env$getLOLAEnrichmenttable() if(!is.null(input$lmc_lola)){ if(!is.na(server_env$getLOLAEnrichmenttable()[[input$lmc_lola]])){ MeDeCom:::do.lola.plot(server_env$getLOLAEnrichmenttable()[[input$lmc_lola]],lola.db,pvalCut=input$pValcut) } + } + }else if(input$diffOutputType == "Annotation Enrichments"){ + server_env$getAnnotationEnrichmenttable() + if(!is.null(input$lmc_annotation)){ + if(!is.na(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]])){ + MeDeCom:::do.annotation.plot(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]],pvalCut=input$pValcut) + } + } } - } - }) } server_env$doTraitAssociation<-function(){ diff --git a/R/server_table.R b/R/server_table.R index 0a6e1ca..54897d7 100644 --- a/R/server_table.R +++ b/R/server_table.R @@ -136,6 +136,11 @@ server_env$lmcgoSelect<-reactive({ selectInput('lmc_lola', 'LMC:', names(server_env$getLOLAEnrichmenttable()), selectize = TRUE) }) + server_env$lmcannotationSelect<-reactive({ + server_env$getAnnotationEnrichmenttable() + selectInput('lmc_annotation', 'LMC:', names(server_env$getAnnotationEnrichmenttable()), selectize = + TRUE) + }) server_env$getLOLAEnrichmenttable<-eventReactive(input$LOLAsubmitQuery, { @@ -232,4 +237,72 @@ output$lolaEnrichementTable<-DT::renderDataTable({ return(data.frame()) } }) + +server_env$getAnnotationEnrichmenttable<-eventReactive(input$AnnotationsubmitQuery, { + showModal(modalDialog("Performing Annotation Enrichments, This may take upto 15 mins depending on the threshold + and number of LMC's", footer=NULL)) + results<-server_env$dataset() + gr_list <- results@parameters$cg_subsets + gr<-as.integer(input$cg_group_5) + cg_ <- gr_list[gr] + ll<-as.integer(input$lambda_5) + lambdas <- results@parameters$lambdas + lambda <- lambdas[ll] + K<-input$K_5 + #finds out the index of k in Ks + Ks<-results@parameters$Ks + type="hypo" + if(input$diffTableType=="hypermethylated"){ + type="hyper" + }else if(input$diffTableType=="differential"){ + type="differential" + } + if(!is.null(input$r_compute) && input$r_compute=="lmcs"){ + lmc=input$lmcs_6_1 + lmc_ref=input$lmcs_6_2 + lmcs <- as.numeric(c(lmc,lmc_ref)) + print(lmcs) + } + out<- tryCatch({ + MeDeCom::lmc.annotation.enrichment(medecom.result=results, + annotation.filter=NULL, + anno.data=server_env$getCGAnnot(), + K=K, + lambda=lambda, + cg_subset=as.integer(cg_), + diff.threshold=input$dmr_threshold, + type=type, + reference.computation=input$r_compute, + comp.lmcs=lmcs, + assembly=input$assembly + ) + }, error = function(err) { + print(paste("MY_ERROR: ",err)) + removeModal() + }) + removeModal() + return(out) + }) +output$annotationEnrichementTable<-DT::renderDataTable({ + server_env$getAnnotationEnrichmenttable() + if(!is.null(input$lmc_annotation)){ + result<-server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]] + if(is.na(result)){ + result<-data.frame( + annotation = character(), + p.value = numeric(), + OddsRatio=numeric() + ) + }else{ + numVars<-sapply(result, is.numeric) + result[numVars] <- lapply(result[numVars], round, digits = 2) + numVars<-names(result) + selected<-c('annotation','p.value', 'OddsRatio') + result<-result[, selected] + } + return(result) + }else{ + return(data.frame()) + } +}) } diff --git a/R/ui_meta_analysis.R b/R/ui_meta_analysis.R index 51bd1ec..1687028 100644 --- a/R/ui_meta_analysis.R +++ b/R/ui_meta_analysis.R @@ -33,7 +33,7 @@ meta_analysis <- function() { conditionalPanel(' input.analysisType === "differential methylation" || input.analysisType === "Enrichments"', conditionalPanel(' input.analysisType === "Enrichments" ', - selectInput('diffOutputType', "Output type:", c("GO Enrichments", "LOLA Enrichments"), selected=1)), + selectInput('diffOutputType', "Output type:", c("GO Enrichments", "LOLA Enrichments", "Annotation Enrichments"), selected=1)), uiOutput("diffTabT"), sliderInput('dmr_threshold', 'Threshold', min=0.0, max=1.0, step=0.01, value=1.0) ), @@ -46,21 +46,34 @@ meta_analysis <- function() { uiOutput("assemblySelector"), numericInput("pValcut", "p-value cutoff", min = 0, max = 1, value=0.01), conditionalPanel('input.diffOutputType === "GO Enrichments" ', - selectInput('r_compute', "Reference Compution:", c("median","mean","lmcs"), selected=1), + selectInput('r_compute', "Reference Computation:", c("median","mean","lmcs"), selected=1), conditionalPanel('input.r_compute === "lmcs" ', uiOutput('lmcs_selector_go') ), uiOutput("lmcgoSelector"), - actionButton('GOsubmitQuery', "Submit GO query")), + actionButton('GOsubmitQuery', "Submit GO query") + ), conditionalPanel('input.diffOutputType === "LOLA Enrichments" ', - selectInput('r_compute', "Reference Compution:", c("median","mean","lmcs"), selected=1), + selectInput('r_compute', "Reference Computation:", c("median","mean","lmcs"), selected=1), conditionalPanel('input.r_compute === "lmcs" ', uiOutput('lmcs_selector') ), - uiOutput("lmclolaSelector"), - actionButton('LOLAsubmitQuery', "Submit LOLA query")) - - ), + uiOutput("lmclolaSelector"), + actionButton('LOLAsubmitQuery', "Submit LOLA query") + ), + ), + conditionalPanel(' input.analysisType === "Enrichments" && + input.diffOutputType === "Annotation Enrichments" ', + numericInput("pValcut", "p-value cutoff", min = 0, max = 1, value=0.01), +# uiOutput("assemblySelector") + selectInput("assembly","Assembly",c("hg19","hg38","mm10"),selected=1), + selectInput('r_compute', "Reference Computation:", c("median","mean","lmcs"), selected=1), + conditionalPanel('input.r_compute === "lmcs" ', + uiOutput('lmcs_selector_annotation') + ), + uiOutput("lmcannotationSelector"), + actionButton('AnnotationsubmitQuery', "Submit Annotation query") + ), conditionalPanel(' input.analysisType === "compare LMCs" && input.PlotType !== "heatmap" ', checkboxInput("correlationCentered_5", "Center matrices", value=FALSE) From 921e8e3e5c96ec808f1d62e0e360449e8116472b Mon Sep 17 00:00:00 2001 From: Michael Scherer Date: Mon, 24 Jun 2024 18:24:33 +0200 Subject: [PATCH 2/4] Minor fixes --- R/server_output.R | 2 +- R/server_output_l_selec.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/server_output.R b/R/server_output.R index 5290d3f..d0cef3c 100644 --- a/R/server_output.R +++ b/R/server_output.R @@ -118,7 +118,7 @@ server_output <- function(input, output, server_env) { if (length(val) == 0) { val = "" } - if (is.recursive(val) || val != "") { + if (is.recursive(val) || val[1] != "") { output[[name]] <- c(display_name, paste(val, collapse = ", ")) } } diff --git a/R/server_output_l_selec.R b/R/server_output_l_selec.R index 7e198bd..7f84cc6 100644 --- a/R/server_output_l_selec.R +++ b/R/server_output_l_selec.R @@ -49,7 +49,7 @@ output$includeStats<-renderUI({ gr_list <- results@parameters$cg_subsets gr<-as.integer(input$cg_group_2) cg_ <- gr_list[gr] - if (!is.na(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="rmseT")) || + if (!any(is.na(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="rmseT"))) || length(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="rmseT"))<1){ output[[i]]<-checkboxInput("includeRMSE_T", "Include RMSE of T", value=FALSE) i<-i+1 @@ -59,7 +59,7 @@ output$includeStats<-renderUI({ # output[[i]]<-checkboxInput("includeDist2C_T", "Include MDC of T", value=FALSE) # i<-i+1 # } - if (!is.na(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="maeA")) || + if (!any(is.na(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="maeA"))) || length(MeDeCom:::getStatistics(results, input$K_2, lmbd, cg_, statistic="maeA"))<1){ output[[i]]<- checkboxInput("includeMAE_A", "Include MAE of A", value=FALSE) i Date: Wed, 26 Jun 2024 11:28:41 +0200 Subject: [PATCH 3/4] Fixed plotting issue --- R/server_table.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/server_table.R b/R/server_table.R index 54897d7..b42f24b 100644 --- a/R/server_table.R +++ b/R/server_table.R @@ -214,7 +214,7 @@ output$lolaEnrichementTable<-DT::renderDataTable({ server_env$getLOLAEnrichmenttable() if(!is.null(input$lmc_lola)){ result<-server_env$getLOLAEnrichmenttable()[[input$lmc_lola]] - if(is.na(result)){ + if(is.null(result)){ result<-data.frame( dbSet = character(), collection = integer(), @@ -225,12 +225,12 @@ output$lolaEnrichementTable<-DT::renderDataTable({ qValue=numeric() ) }else{ - numVars<-sapply(result, is.numeric) - result[numVars] <- lapply(result[numVars], round, digits = 2) - numVars<-names(result) - selected<-c('dbSet','collection','pValueLog', 'oddsRatio', 'description', 'cellType', 'qValue') - result$description <- gsub(x = result$description, pattern = ";", replace = ", ") - result<-result[, selected] + numVars<-sapply(result, is.numeric) + result[numVars] <- lapply(result[numVars], round, digits = 2) + numVars<-names(result) + selected<-c('dbSet','collection','pValueLog', 'oddsRatio', 'description', 'cellType', 'qValue') + result$description <- gsub(x = result$description, pattern = ";", replace = ", ") + result<-result[, selected] } return(result) }else{ From ece765dcea17e98fcd381e4b42ee51e219917dd6 Mon Sep 17 00:00:00 2001 From: Michael Scherer Date: Wed, 26 Jun 2024 12:29:01 +0200 Subject: [PATCH 4/4] Some fixes in the Meta Analysis --- R/server_plot.R | 6 +++--- R/server_table.R | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/server_plot.R b/R/server_plot.R index 6f917d3..fe02183 100644 --- a/R/server_plot.R +++ b/R/server_plot.R @@ -532,21 +532,21 @@ server_env$doMetaPlot<-function(){ if (input$diffOutputType == "GO Enrichments"){ server_env$getGOEnrichmenttable() if(!is.null(input$lmc_go)){ - if(!is.na(server_env$getGOEnrichmenttable()[[input$lmc_go]])){ + if(!is.null(server_env$getGOEnrichmenttable()[[input$lmc_go]])){ MeDeCom:::do.go.plot(server_env$getGOEnrichmenttable()[[input$lmc_go]], pvalCut=input$pValcut) } } }else if(input$diffOutputType == "LOLA Enrichments"){ server_env$getLOLAEnrichmenttable() if(!is.null(input$lmc_lola)){ - if(!is.na(server_env$getLOLAEnrichmenttable()[[input$lmc_lola]])){ + if(!is.null(server_env$getLOLAEnrichmenttable()[[input$lmc_lola]])){ MeDeCom:::do.lola.plot(server_env$getLOLAEnrichmenttable()[[input$lmc_lola]],lola.db,pvalCut=input$pValcut) } } }else if(input$diffOutputType == "Annotation Enrichments"){ server_env$getAnnotationEnrichmenttable() if(!is.null(input$lmc_annotation)){ - if(!is.na(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]])){ + if(!is.null(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]])){ MeDeCom:::do.annotation.plot(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]],pvalCut=input$pValcut) } } diff --git a/R/server_table.R b/R/server_table.R index b42f24b..1e0ee9b 100644 --- a/R/server_table.R +++ b/R/server_table.R @@ -287,18 +287,18 @@ output$annotationEnrichementTable<-DT::renderDataTable({ server_env$getAnnotationEnrichmenttable() if(!is.null(input$lmc_annotation)){ result<-server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]] - if(is.na(result)){ + if(is.null(result)){ result<-data.frame( annotation = character(), p.value = numeric(), OddsRatio=numeric() ) }else{ - numVars<-sapply(result, is.numeric) - result[numVars] <- lapply(result[numVars], round, digits = 2) - numVars<-names(result) - selected<-c('annotation','p.value', 'OddsRatio') - result<-result[, selected] + numVars<-sapply(result, is.numeric) + result[numVars] <- lapply(result[numVars], round, digits = 2) + numVars<-names(result) + selected<-c('annotation','p.value', 'OddsRatio') + result<-result[, selected] } return(result) }else{