Merge pull request #11 from yigbt/devel

Devel

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: multiGSEA
 Type: Package
 Title: Combining GSEA-based pathway enrichment with multi omics data integration
-Version: 1.9.1
+Version: 1.11.2
 Date: 2020-03-05
 Authors@R: c(
     person( "Sebastian", "Canzler", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7935-9582")),

R/enrichment_functions.R

@@ -11,6 +11,7 @@
 #'   respective omics layer.
 #' @param ranks Nested list containing the measured and pre-ranked features for
 #'   each omics layer.
+#' @param eps This parameter sets the boundary for calculating the p value.
 #'
 #' @return Nested list containing the enrichment scores for each given pathway
 #'   and omics layer.
@@ -34,17 +35,15 @@
 #' @importFrom fgsea fgseaMultilevel
 #'
 #' @export
-multiGSEA <- function(pathways, ranks) {
-
-    # Go through all omics layer.
-    es <- lapply(names(pathways), function(omics) {
-        fgseaMultilevel(pathways[[omics]], ranks[[omics]], eps = 0)
-    })
+multiGSEA <- function(pathways, ranks, eps = 0) {
+  # Go through all omics layer.
+  es <- lapply(names(pathways), function(omics) {
+    fgsea::fgseaMultilevel(pathways[[omics]], ranks[[omics]], eps = eps)
+  })
 
-    names(es) <- names(pathways)
+  names(es) <- names(pathways)
 
-    return(es)
-
+  return(es)
 }
 
 
@@ -79,31 +78,29 @@ multiGSEA <- function(pathways, ranks) {
 #' es <- multiGSEA(pathways, ranks)
 #'
 #' extractPvalues(
-#'     enrichmentScores = es,
-#'     pathwayNames = names(pathways[[1]])
+#'   enrichmentScores = es,
+#'   pathwayNames = names(pathways[[1]])
 #' )
 #' @export
 extractPvalues <- function(enrichmentScores, pathwayNames) {
-
-    # Go through all the pathways
-    res <- lapply(pathwayNames, function(name) {
-
-        # Go through all the possible omics layer
-        unlist( lapply(names(enrichmentScores), function(y) {
-            df <- enrichmentScores[[y]][which(enrichmentScores[[y]]$pathway == name), c(2, 3)]
-            if (nrow(df) == 0) {
-                df <- data.frame(pval = NA, padj = NA)
-            }
-            names(df) <- paste0(y, "_", names(df))
-            df
-        }))
-    })
-
-    # Combine the list elements to a data frame and assign the pathway names as rownames
-    res <- data.frame(do.call(rbind, res))
-
-    return(res)
-
+  # Go through all the pathways
+  res <- lapply(pathwayNames, function(name) {
+    # Go through all the possible omics layer
+    unlist(lapply(names(enrichmentScores), function(y) {
+      df <- enrichmentScores[[y]][which(enrichmentScores[[y]]$pathway == name), c(2, 3)]
+      if (nrow(df) == 0) {
+        df <- data.frame(pval = NA, padj = NA)
+      }
+      names(df) <- paste0(y, "_", names(df))
+      df
+    }))
+  })
+
+  # Combine list elements to data frame
+  # and assign pathway names as rownames
+  res <- data.frame(do.call(rbind, res))
+
+  return(res)
 }
 
 
@@ -144,53 +141,50 @@ extractPvalues <- function(enrichmentScores, pathwayNames) {
 #'
 #' @export
 combinePvalues <- function(df, method = "stouffer", weights = NULL) {
-
-    method <- tolower(method)
-    if (!method %in% c("stouffer", "fisher", "edgington")) {
-        stop("You can chose between the 'stouffer', 'edgington', 
+  method <- tolower(method)
+  if (!method %in% c("stouffer", "fisher", "edgington")) {
+    stop("You can chose between the 'stouffer', 'edgington',
               and 'fisher' method to combine p-values.",
-            call. = FALSE
-        )
-    }
-
-    cols <- grep("padj", colnames(df))
-
-    pvals <- apply(df, 1, function(row) {
-        row <- row[cols]
-        row <- row[!is.na(row)]
+      call. = FALSE
+    )
+  }
+
+  cols <- grep("padj", colnames(df))
+
+  pvals <- apply(df, 1, function(row) {
+    row <- row[cols]
+    row <- row[!is.na(row)]
+
+    if (length(row) >= 2) {
+      if (method == "fisher") {
+        p <- metap::sumlog(row)
+        p$p
+      } else if (method == "edgington") {
+        p <- metap::sump(row)
+        p$p
+      } else {
+        ## sumz allows only p-values smaller than 1
+        row <- row[row > 0 & row < 1]
 
         if (length(row) >= 2) {
-            if (method == "fisher") {
-                p <- sumlog(row)
-                p$p
-            } else if (method == "edgington") {
-                p <- sump(row)
-                p$p
-            } else {
-
-                ## sumz allows only p-values smaller than 1
-                row <- row[row > 0 & row < 1]
-
-                if (length(row) >= 2) {
-                    if (length(weights) > 0) {
-                        p <- sumz(row, weights = weights)
-                    } else {
-                        p <- sumz(row)
-                    }
-                    p$p
-                } else if (length(row == 1)) {
-                    row[1]
-                } else {
-                    NA
-                }
-            }
-        } else if (length(row) == 1) {
-            row[1]
+          if (length(weights) > 0) {
+            p <- metap::sumz(row, weights = weights)
+          } else {
+            p <- metap::sumz(row)
+          }
+          p$p
+        } else if (length(row == 1)) {
+          row[1]
         } else {
-            NA
+          NA
         }
-    })
+      }
+    } else if (length(row) == 1) {
+      row[1]
+    } else {
+      NA
+    }
+  })
 
-    return(pvals)
-
+  return(pvals)
 }