new release

components/app/R/global.R

@@ -199,8 +199,26 @@ message("************* SETTING DEFAULTS ***************")
 message("************************************************")
 
 defaults.file <- file.path(ETC, "DEFAULTS.yml")
-if (!file.exists(defaults.file)) stop("FATAL ERROR: cannot find DEFAULTS.yml file")
-DEFAULTS <<- yaml::read_yaml(defaults.file)
+if (file.exists(defaults.file)) {
+  DEFAULTS <<- yaml::read_yaml(defaults.file)
+} else {
+  message("[GLOBAL] DEFAULTS.yml not found, using default configuration")
+  DEFAULTS <<- list(
+    computation_options = list(
+      probe_filtering = list(
+        default = c(
+          "remove.notexpressed",
+          "remove.unknown",
+          "only.proteincoding"
+        ),
+        proteomics = list()
+      )
+    ),
+    qc = list(
+      impute = TRUE
+    )
+  )
+}
 
 ## Check and set authentication method
 if (Sys.getenv("PLAYGROUND_AUTHENTICATION") != "") {

components/app/R/server.R

@@ -1258,17 +1258,22 @@ app_server <- function(input, output, session) {
     if (auth$logged) {
       shinyjs::delay(500, {
         ## read startup messages
-        msg <- readLines(file.path(ETC, "MESSAGES"))
-        msg <- msg[msg != "" & substr(msg, 1, 1) != "#"]
-        msg <- c(msg[[1]], sample(msg, 4))
-        STARTUP_MESSAGES <- msg
-        shiny::showModal(
-          ui.startupModal(
-            id = "startup_modal",
-            messages = STARTUP_MESSAGES,
-            title = "BigOmics Highlights"
-          )
-        )
+        msg_file <- file.path(ETC, "MESSAGES")
+        if (file.exists(msg_file)) {
+          msg <- readLines(msg_file)
+          msg <- msg[msg != "" & substr(msg, 1, 1) != "#"]
+          if (length(msg) > 0) {
+            msg <- c(msg[[1]], sample(msg, min(4, length(msg))))
+            STARTUP_MESSAGES <- msg
+            shiny::showModal(
+              ui.startupModal(
+                id = "startup_modal",
+                messages = STARTUP_MESSAGES,
+                title = "BigOmics Highlights"
+              )
+            )
+          }
+        }
       })
     }
   })

components/board.compare/R/compare_plot_genecorr.R

@@ -233,7 +233,7 @@ compare_plot_genecorr_server <- function(id,
       # Assemble all subplot in to grid
       plt <- plotly::subplot(
         sub_plots,
-        nrows = 4,
+        nrows = min(4, length(sub_plots)),
         margin = 0.03,
         titleX = TRUE,
         titleY = TRUE

components/board.correlation/R/correlation_server.R

@@ -61,6 +61,9 @@ CorrelationBoard <- function(id, pgx, labeltype = shiny::reactive("feature")) {
       ## genes <- sort(pgx$genes[genes, ]$gene_name)
       sel <- genes[1] ## most var gene
       ## sel <- names(head(sort(-rowMeans(playbase::pgx.getMetaMatrix(pgx)$fc**2)), 1))
+
+      names(genes) <- playbase::probe2symbol(genes, pgx$genes, labeltype(), fill_na = TRUE)
+
       shiny::updateSelectizeInput(
         session, "gene",
         choices = genes, selected = sel, server = TRUE

components/board.enrichment/R/enrichment_plot_top_enrich_gsets.R

@@ -96,12 +96,8 @@ enrichment_plot_top_enrich_gsets_server <- function(id,
       }
 
       ## selected
-      sel <- as.integer(gseatable$rows_selected())
-      sel.gs <- NULL
-      if (!is.null(sel) && length(sel) > 0) sel.gs <- rownames(rpt)[sel]
-
-      ii <- gseatable$rows_selected()
-      jj <- gseatable$rows_current()
+      ii <- gseatable$rownames_selected()
+      jj <- gseatable$rownames_current()
       shiny::req(jj)
 
       if (nrow(rpt) == 0) {

components/board.enrichment/R/enrichment_server.R

@@ -368,7 +368,7 @@ EnrichmentBoard <- function(id, pgx,
     ## Enrichment table
     ## ================================================================================
 
-    gset_selected <- shiny::reactive({
+    gset_selected.SAVE <- shiny::reactive({
       i <- as.integer(gseatable$rows_selected())
       if (is.null(i) || length(i) == 0) {
         return(NULL)
@@ -378,6 +378,14 @@ EnrichmentBoard <- function(id, pgx,
       return(gs)
     })
 
+    gset_selected <- shiny::reactive({
+      gs <- gseatable$rownames_selected()
+      if (is.null(gs) || length(gs) == 0) {
+        return(NULL)
+      }
+      return(gs)
+    })
+
     geneDetails <- shiny::reactive({
       ## return details of the genes in the selected gene set
       shiny::req(pgx$X, input$gs_contrast)

components/board.enrichment/R/enrichment_table_enrichment_analysis.R

@@ -15,12 +15,13 @@ enrichment_table_enrichment_analysis_ui <- function(
 
   gseatable_opts <- shiny::tagList(
     withTooltip(shiny::checkboxInput(ns("gs_showqvalues"), "Show individual q-values", FALSE),
-      "Show q-values of each statistical method in the table.",
-      placement = "top", options = list(container = "body")
+      "Show q-values of each statistical method in the table."
     ),
     withTooltip(shiny::checkboxInput(ns("show_scores"), "Show method-specific score", FALSE),
-      "Show enrichment score of each statistical method in the table.",
-      placement = "top", options = list(container = "body")
+      "Show enrichment score of each statistical method in the table."
+    ),
+    withTooltip(shiny::checkboxInput(ns("rowgroup"), "Group by database", FALSE),
+      "Groups genesets by database."
     )
   )
 
@@ -60,7 +61,7 @@ enrichment_table_enrichment_analysis_server <- function(id,
         return(NULL)
       }
 
-      if ("GS" %in% colnames(rpt)) rpt$GS <- playbase::shortstring(rpt$GS, 72)
+      if ("GS" %in% colnames(rpt)) rpt$GS <- playbase::shortstring(rpt$GS, 60)
       if ("size" %in% colnames(rpt)) rpt$size <- as.integer(rpt$size)
 
       fx <- NULL
@@ -91,17 +92,27 @@ enrichment_table_enrichment_analysis_server <- function(id,
       rpt$GS <- paste(rpt$GS, "&nbsp;", GS_link)
       colnames(rpt) <- sub("GS", "geneset", colnames(rpt))
 
+      if(input$rowgroup) {
+        db <- sub(":.*","",rownames(rpt))
+        rpt <- cbind( DB = db, rpt )
+        rpt <- rpt[order(rpt$DB, rpt$meta.q, -abs(rpt$logFC)), ]
+      }
+
       is.numcol <- sapply(rpt, function(col) is.numeric(col) && !is.integer(col))
       numcols <- which(is.numcol & !colnames(rpt) %in% c("size"))
       numcols <- colnames(rpt)[numcols]
+      escapecols <- -1 * (match(c("geneset"), colnames(rpt)) + 0)
 
-
+      rowgroup.opt <- NULL
+      if(input$rowgroup) rowgroup.opt <- list(dataSrc = 0)
+
       DT::datatable(rpt,
         class = "compact cell-border stripe hover",
         rownames = FALSE,
-        escape = c(-1, -2),
-        extensions = c("Scroller"),
-        plugins = "scrollResize",
+        #escape = c(-1, -2),
+        escape = escapecols,
+        extensions = c("Scroller","RowGroup"),
+        plugins = c("scrollResize","ellipsis"),
         fillContainer = TRUE,
         selection = list(mode = "single", target = "row", selected = 1),
         options = list(
@@ -113,10 +124,15 @@ enrichment_table_enrichment_analysis_server <- function(id,
           scrollResize = TRUE,
           scroller = TRUE,
           deferRender = TRUE,
+          rowGroup = rowgroup.opt,
           search = list(
             regex = TRUE,
             caseInsensitive = TRUE
-          )
+          ),
+          columnDefs = list(list(
+            targets = c("geneset"),
+            render = DT::JS("$.fn.dataTable.render.ellipsis( 60, false )")
+          ))          
         ) ## end of options.list
       ) %>%
         DT::formatSignif(numcols, 4) %>%