GSEA support (WIP)

DESCRIPTION

@@ -5,9 +5,10 @@ Authors@R: person("Jonathan", "Manning", email = "[email protected]", r
 Description: Provides Shiny applications for various array and NGS applications.
     Currently very RNA-seq centric, with plans for expansion.
 Depends:
-    R (>= 3.2.2),
+    R (>= 3.4.0),
     SummarizedExperiment
 License: AGPL (>= 3)
+Encoding: UTF-8
 LazyData: true
 Imports:
     cluster,
@@ -53,6 +54,6 @@ Remotes:
     cran/d3heatmap,
     pinin4fjords/zhangneurons
 biocViews: Software
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr
 Config/testthat/edition: 3

R/ExploratorySummarizedExperiment-class.R

@@ -1,8 +1,6 @@
 #' The ExploratorySummarizedExperiment class
 #'
-#' Subclass of SummarizedExperiment if present in the SummarizedExperiment
-#' package (newer versions of Bioconductor have moved this from GenomicRanges),
-#' otherwise of SummarizedExperiment0.
+#' Subclass of SummarizedExperiment.
 #'
 #' @slot idfield character.
 #' @slot entrezgenefield character.
@@ -12,21 +10,17 @@
 #' @slot gene_set_analyses list.
 #' @slot dexseq_results list.
 #' @slot read_reports list.
+#' @slot gene_set_analyses_tool list.
 #'
 #' @export
 
-setClass("ExploratorySummarizedExperiment", contains = ifelse("SummarizedExperiment" %in% getClasses(where = "package:SummarizedExperiment"), "SummarizedExperiment",
-  "SummarizedExperiment0"
-), representation = representation(
+setClass("ExploratorySummarizedExperiment", contains = "SummarizedExperiment", slots = c(
   idfield = "character", entrezgenefield = "character", labelfield = "character", contrast_stats = "list",
-  assay_measures = "list", gene_set_analyses = "list", dexseq_results = "list", read_reports = "list"
+  assay_measures = "list", gene_set_analyses = "list", dexseq_results = "list", read_reports = "list", gene_set_analyses_tool = "list"
 ))
 
 setAs("RangedSummarizedExperiment", "ExploratorySummarizedExperiment", function(from) {
-  as(
-    (as(from, ifelse("SummarizedExperiment" %in% getClasses(where = "package:SummarizedExperiment"), "SummarizedExperiment", "SummarizedExperiment0"))),
-    "ExploratorySummarizedExperiment"
-  )
+  as(as(from, "SummarizedExperiment"), "ExploratorySummarizedExperiment")
 })
 
 #' ExploratorySummarizedExperiments
@@ -63,21 +57,23 @@ setAs("RangedSummarizedExperiment", "ExploratorySummarizedExperiment", function(
 #' correspond to 'contrasts' set in the containing SummarizedExperimentList.
 #' @param assay_measures Optional List of measures to display related to each
 #' assay.
-#' @param gene_set_analyses List of lists of gene set tables keyed first by
-#' gene set
-#' type and secondly by contrast
+#' @param gene_set_analyses Three-level nested lists of gene set tables keyed first by
+#' assay, then by gene set type and then by contrast.
 #' @param read_reports A named list of matrices with read counts in columns
 #' and sample names in rows. Useful for providing mapped read counts,
 #' counts per gene type etc
 #' @param dexseq_results An optional list of \code{DEXSeqResults} objects
 #' corresponding to the contrasts listed in the \code{contrasts} slot..
+#' @param gene_set_analyses_tool Three-level nested lists of a string, nested as \code{gene_set_analyses}.
+#' Each string may be \code{"auto"} (the default), \code{"gsea"} or \code{"roast"}. It defines the format of the
+#' corresponding \code{gene_set_analyses} table.
 #'
 #' @return output An ExploratoryRangedSummarizedExperient object
 #' @rawNamespace import(SummarizedExperiment, except = 'shift')
 #' @export
 
 ExploratorySummarizedExperiment <- function(assays, colData, annotation, idfield, labelfield = character(), entrezgenefield = character(), contrast_stats = list(),
-                                            assay_measures = list(), gene_set_analyses = list(), dexseq_results = list(), read_reports = list()) {
+                                            assay_measures = list(), gene_set_analyses = list(), dexseq_results = list(), read_reports = list(), gene_set_analyses_tool = list()) {
   # Reset NULLs to empty
 
   if (is.null(entrezgenefield)) {
@@ -116,13 +112,75 @@ ExploratorySummarizedExperiment <- function(assays, colData, annotation, idfield
 
   annotation <- data.frame(lapply(annotation, as.character), stringsAsFactors = FALSE, check.names = FALSE, row.names = rownames(annotation))[all_rows, ]
 
+  # Ensure consistency between gene_set_analyses with gene_set_analyses_tool
+  gene_set_analyses_tool <- check_gene_set_analyses_tool_consistency(gene_set_analyses, gene_set_analyses_tool)
+
   # Build the object
 
   sumexp <- SummarizedExperiment(assays = assays, colData = DataFrame(colData, check.names = FALSE))
   mcols(sumexp) <- annotation
 
   new("ExploratorySummarizedExperiment", sumexp,
     idfield = idfield, labelfield = labelfield, entrezgenefield = entrezgenefield, assay_measures = assay_measures,
-    contrast_stats = contrast_stats, gene_set_analyses = gene_set_analyses, dexseq_results = dexseq_results, read_reports = read_reports
+    contrast_stats = contrast_stats, gene_set_analyses = gene_set_analyses, dexseq_results = dexseq_results, read_reports = read_reports,
+    gene_set_analyses_tool = gene_set_analyses_tool
   )
 }
+
+#' Ensure consistency between gene_set_analyses and gene_set_analyses_tool structures
+#'
+#' @description
+#' Ensures that the structure of \code{gene_set_analyses_tool} matches that of \code{gene_set_analyses},
+#' filling in missing elements as needed. Each entry in \code{gene_set_analyses_tool} should be a string
+#' (e.g., "auto", "gsea", or "roast") corresponding to the format of the associated gene set analysis table.
+#'
+#' @param gene_set_analyses A three-level nested list of gene set tables, keyed by assay, gene set type, and contrast.
+#' @param gene_set_analyses_tool A three-level nested list of strings, structured as \code{gene_set_analyses}, indicating the tool used for each gene set analysis.
+#'
+#' @return A three-level nested list of strings, matching the structure of \code{gene_set_analyses}, with missing elements filled as needed.
+check_gene_set_analyses_tool_consistency <- function(gene_set_analyses, gene_set_analyses_tool) {
+  # gene_set_analyses and gene_set_analyses_tool should have the same list of lists
+  # structure. gene_set_analyses_tool should have a single string
+
+  # Create default structure if necessary:
+  out <- list()
+
+  if (is.null(gene_set_analyses_tool)) {
+    gene_set_analyses_tool <- list()
+  }
+  for (assay_name in names(gene_set_analyses)) {
+    if (!assay_name %in% names(gene_set_analyses_tool)) {
+      gene_set_analyses_tool[[assay_name]] <- list()
+    }
+    for (gs_type in names(gene_set_analyses[[assay_name]])) {
+      if (! gs_type %in% names(gene_set_analyses_tool[[assay_name]])) {
+        gene_set_analyses_tool[[assay_name]][[gs_type]] <- list()
+      }
+      for (contrast_name in names(gene_set_analyses[[assay_name]][[gs_type]])) {
+        if (! contrast_name %in% names(gene_set_analyses_tool[[assay_name]][[gs_type]])) {
+          gene_set_analyses_tool[[assay_name]][[gs_type]][[contrast_name]] <- "auto"
+        } else {
+          tool_name <- gene_set_analyses_tool[[assay_name]][[gs_type]][[contrast_name]]
+          if (!is.character(tool_name) || length(tool_name) > 1) {
+            stop(paste0("Invalid gene_set_analyses_tool. gene_set_analyses_tool for ",
+                        gs_type, " and ", contrast_name, " should be one of 'auto', 'gsea' or 'roast'. Found ",
+                        paste0(tool_name, collapse=",")))
+          }
+          if (! tool_name %in% c("auto", "gsea", "roast")) {
+            stop(paste0("Invalid gene_set_analyses_tool. gene_set_analyses_tool for ",
+                        gs_type, " and ", contrast_name, " should be one of 'auto', 'gsea' or 'roast'. Found ",
+                        tool_name))
+          }
+        }
+      }
+      # In case gene_set_analyses_tool has other entries, just keep the ones matching gene_set_analyses
+      contrasts_ordered <- names(gene_set_analyses[[assay_name]][[gs_type]])
+      gene_set_analyses_tool[[assay_name]][[gs_type]] <- gene_set_analyses_tool[[assay_name]][[gs_type]][contrasts_ordered]
+    }
+    gene_set_type_names_ordered <- names(gene_set_analyses[[assay_name]])
+    gene_set_analyses_tool[[assay_name]] <- gene_set_analyses_tool[[assay_name]][gene_set_type_names_ordered]
+  }
+  analysis_names_ordered <- names(gene_set_analyses_tool)
+  gene_set_analyses_tool <- gene_set_analyses_tool[analysis_names_ordered]
+  gene_set_analyses_tool
+}

R/ExploratorySummarizedExperimentList-class.R

@@ -15,7 +15,7 @@
 #'
 #' @export
 
-setClass("ExploratorySummarizedExperimentList", contains = "list", representation = representation(
+setClass("ExploratorySummarizedExperimentList", contains = "list", slots = c(
   title = "character", author = "character", description = "character", static_pdf = "character",
   group_vars = "character", default_groupvar = "character", contrasts = "list", url_roots = "list", gene_sets = "list", gene_set_id_type = "character", ensembl_species = "character"
 ))
@@ -149,7 +149,7 @@ ExploratorySummarizedExperimentList <- function(eses, title = "", author = "", d
       } else {
         # Numeric IDs (like entrez will be cast to integers)
 
-        is_numeric <- all(!is.na(as.numeric(annotation[[gene_set_id_type]])))
+        is_numeric <- all(!is.na(suppressWarnings(as.numeric(annotation[[gene_set_id_type]]))))
       }
 
       print("Processing gene sets")

R/accessory.R

@@ -682,13 +682,37 @@ eselistfromConfig <-
       }
 
       if ("gene_set_analyses" %in% names(exp)) {
+        # Basic list to pass to object creation
+        exp$gene_set_analyses_tool <- check_gene_set_analyses_tool_consistency(exp$gene_set_analyses, exp$gene_set_analyses_tool)
+
         ese_list$gene_set_analyses <- lapply(exp$gene_set_analyses, function(assay) {
           lapply(assay, function(gene_set_type) {
             lapply(gene_set_type, function(contrast) {
-              read.csv(contrast, check.names = FALSE, stringsAsFactors = FALSE, row.names = 1)
+              # contrast may be one file name or two file names (up and down), or NULL
+              if (is.null(contrast) || length(contrast) == 0) {
+                NULL
+              } else if (length(contrast) == 1) {
+                read.csv(contrast, sep=getSeparator(contrast),
+                         check.names = FALSE, stringsAsFactors = FALSE, row.names = 1)
+              } else if (length(contrast) == 2) {
+                # This is useful for GSEA output, that splits up and down in two tsv files.
+                # We read both files and set the direction
+                up <- read.csv(contrast[["up"]], sep=getSeparator(contrast[["up"]]),
+                               check.names = FALSE, stringsAsFactors = FALSE, row.names = 1)
+                up$Direction <- rep("Up", nrow(up))
+                down <- read.csv(contrast[["down"]], sep=getSeparator(contrast[["down"]]),
+                               check.names = FALSE, stringsAsFactors = FALSE, row.names = 1)
+                down$Direction <- rep("Down", nrow(down))
+                rbind(up, down)
+              } else {
+                stop("gene_set_analyses should have zero, one or two contrast files per gene_set_type")
+              }
             })
           })
         })
+
+        ese_list$gene_set_analyses <- remove_nulls(ese_list$gene_set_analyses)
+        ese_list$gene_set_analyses_tool <- exp$gene_set_analyses_tool
       }
 
       do.call(ExploratorySummarizedExperiment, ese_list)
@@ -751,6 +775,19 @@ eselistfromConfig <-
     eselist
   }
 
+#' Recursively remove NULL entries from a nested list
+#'
+#' @param x A list (possibly nested) from which NULL entries should be removed.
+#'
+#' @return The input list with all NULL entries recursively removed.
+remove_nulls <- function(x) {
+  if (is.list(x) && !is.data.frame(x)) {
+    x <- lapply(x, remove_nulls)
+    x <- Filter(Negate(is.null), x)
+  }
+  return(x)
+}
+
 #' Read an expression matrix file and match to specified samples and features
 #'
 #' @param matrix_file Matrix file
@@ -1464,3 +1501,65 @@ cond_log2_transform_assays <- function(assay_data, log2_assays, threshold = 30,
   return(assay_data)
 }
 
+#' Extract and standardize gene set enrichment columns
+#'
+#' @description
+#'   Determines the appropriate column names for p-value, FDR, and direction in a gene set enrichment result data frame,
+#'   based on the tool used (e.g., "gsea" or "roast"). Optionally removes extraneous columns for GSEA results.
+#'
+#' @param gst A data frame from a gene enrichment tool (e.g., roast, gsea).
+#' @param gs_tool A string specifying the tool used to generate \code{gst}. One of "auto", "gsea", or "roast".
+#'
+#' @return A list with the following elements:
+#'   \describe{
+#'     \item{gst}{The possibly modified input data frame with extraneous columns removed (for GSEA).}
+#'     \item{gs_tool}{The detected or specified gene set analysis tool.}
+#'     \item{pvalue_col_name}{The name of the p-value column.}
+#'     \item{fdr_col_name}{The name of the FDR column.}
+#'     \item{direction_col_name}{The name of the direction column.}
+#'   }
+#'
+get_gst_columns <- function(gst, gs_tool) {
+  # Auto-detection:
+  if (gs_tool == "auto") {
+    if ("NOM p-val" %in% colnames(gst)) {
+      gs_tool <- "gsea"
+    }
+    else if (any(c("p value", "PValue") %in% colnames(gst))) {
+      gs_tool <- "roast"
+    } else {
+      stop("Could not detect gs_tool method.")
+    }
+  }
+
+  if (gs_tool == "roast") {
+    # mroast has PValue instead of "p value", check:
+    if ("PValue" %in% colnames(gst)) {
+      pvalue_col_name <- "PValue"
+    } else {
+      pvalue_col_name <- "p value"
+    }
+    fdr_col_name <- "FDR"
+    direction_col_name <- "Direction"
+  } else if (gs_tool == "gsea") {
+    pvalue_col_name <- "NOM p-val"
+    fdr_col_name <- "FDR q-val"
+    direction_col_name <- "Direction"
+  } else {
+    stop(paste0("Invalid gene_set_analyses_tool: ", gs_tool))
+  }
+
+  if (gs_tool == "gsea") {
+    # gsea tsv files have two useless columns that can be removed:
+    cols_to_remove <- c("GS<br> follow link to MSigDB", "GS DETAILS")
+    gst <- gst[ , !(names(gst) %in% cols_to_remove), drop=FALSE]
+  }
+
+  list(
+    gst = gst,
+    gs_tool = gs_tool,
+    pvalue_col_name = pvalue_col_name,
+    fdr_col_name = fdr_col_name,
+    direction_col_name = direction_col_name
+  )
+}

R/genesetanalysistable.R

@@ -237,10 +237,33 @@ genesetanalysistable <- function(input, output, session, eselist) {
     selected_contrasts <- getSelectedContrastNumbers()[[1]]
 
     gst <- ese@gene_set_analyses[[assay]][[gene_set_types]][[as.numeric(selected_contrasts)]]
-
-    # Rename p value if we have PValue from mroast etc()
-
-    colnames(gst) <- sub("PValue", "p value", colnames(gst))
+
+    # Get the tool used for enrichment, or auto-detect it:
+    if ("gene_set_analyses_tool" %in% slotNames(ese)) {
+      gs_tool <- ese@gene_set_analyses_tool[[assay]][[gene_set_types]][[as.numeric(selected_contrasts)]]
+    } else {
+      gs_tool <- "auto"
+    }
+
+    gst_and_colinfo <- get_gst_columns(gst, gs_tool)
+    # unpack:
+    gst <- gst_and_colinfo$gst
+    gs_tool <- gst_and_colinfo$gs_tool
+    pvalue_col_name <- gst_and_colinfo$pvalue_col_name
+    fdr_col_name <- gst_and_colinfo$fdr_col_name
+    direction_col_name <- gst_and_colinfo$direction_col_name
+
+    if (!pvalue_col_name %in% colnames(gst)) {
+      stop(paste0(pvalue_col_name, " column not found in gst. Found: ", paste0(colnames(gst), collapse=", ")))
+    }
+
+    if (!fdr_col_name %in% colnames(gst)) {
+      stop(paste0(fdr_col_name, " column not found in gst. Found: ", paste0(colnames(gst), collapse=", ")))
+    }
+
+    if (!direction_col_name %in% colnames(gst)) {
+      stop(paste0(direction_col_name, " column not found in gst. Found: ", paste0(colnames(gst), collapse=", ")))
+    }
 
     # Select out specific gene sets if they've been provided
 
@@ -258,7 +281,7 @@ genesetanalysistable <- function(input, output, session, eselist) {
 
     # Apply the user's filters
 
-    gst <- gst[gst[["p value"]] < input$pval & gst[["FDR"]] < input$fdr, , drop = FALSE]
+    gst <- gst[gst[[pvalue_col_name]] < input$pval & gst[[fdr_col_name]] < input$fdr, , drop = FALSE]
 
     validate(need(nrow(gst) > 0, "No results matching specified filters"))
 
@@ -272,7 +295,7 @@ genesetanalysistable <- function(input, output, session, eselist) {
       gene_sets <- getGeneSets()
 
       gst$significant_genes <- apply(gst, 1, function(row) {
-        if (row["Direction"] == "Up") {
+        if (row[direction_col_name] == "Up") {
           siggenes <- intersect(gene_sets[[getGeneSetTypes()]][[row["gene_set_id"]]], up)
         } else {
           siggenes <- intersect(gene_sets[[getGeneSetTypes()]][[row["gene_set_id"]]], down)
@@ -289,15 +312,15 @@ genesetanalysistable <- function(input, output, session, eselist) {
   getDisplayGeneSetAnalysis <- reactive({
     gst <- getGeneSetAnalysis()
 
-    # Add links, but use a prettiefied version of the gene set name that re-flows to take up less space
+    # Add links, but use a prettified version of the gene set name that re-flows to take up less space
 
     gst <- linkMatrix(gst, eselist@url_roots, data.frame(gene_set_id = prettifyGeneSetName(gst$gene_set_id), stringsAsFactors = FALSE))
     colnames(gst) <- prettifyVariablename(colnames(gst))
 
     gst
   })
 
-  # Make an explantory file name
+  # Make an explanatory file name
 
   makeFileName <- reactive({
     gsub("[^a-zA-Z0-9_]", "_", paste("gsa", getSelectedContrastNames(), getGeneSetTypes()))