Some bugfixes

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 = ", "))
             }
           }
@@ -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"){

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<i+1

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]])
+    )
+  })
 }

R/server_plot.R

@@ -532,19 +532,25 @@ 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.null(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]])){
+            MeDeCom:::do.annotation.plot(server_env$getAnnotationEnrichmenttable()[[input$lmc_annotation]],pvalCut=input$pValcut)
+          }
+        }
       }
-      }
-
 })
 }
 server_env$doTraitAssociation<-function(){

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, {
@@ -209,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(),
@@ -220,12 +225,80 @@ 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{
+    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.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]
     }
     return(result)
   }else{

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)