reconciled sites

montilab · Sep 18, 2023 · 0f5ae2e · 0f5ae2e
2 parents bdb2531 + a74b3b8
commit 0f5ae2e
Show file tree

Hide file tree

Showing 12 changed files with 181 additions and 92 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: hypeR
 Title: An R Package For Geneset Enrichment Workflows
-Version: 2.0.0
+Version: 2.0.1
 Authors@R: c(person(given="Anthony", family="Federico", email="anfed@bu.edu", 
              role=c("aut", "cre")),
              person(given="Stefano", family="Monti", email="smonti@bu.edu", 

diff --git a/NAMESPACE b/NAMESPACE
@@ -93,6 +93,7 @@ importFrom(reactable,reactable)
 importFrom(reshape2,melt)
 importFrom(rlang,duplicate)
 importFrom(rmarkdown,render)
+importFrom(scales,log10_trans)
 importFrom(scales,log_breaks)
 importFrom(scales,trans_new)
 importFrom(shiny,NS)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# hypeR 2.0.1
+* Dots plots are now explicitly sized with `size_by=c("genesets", "significance", "none")` 
+
 # hypeR 2.0.0
 * Version bump for bioconductor
 

diff --git a/R/hyp_dots.R b/R/hyp_dots.R
@@ -3,7 +3,7 @@
 #' @param multihyp_data A list of hyp objects
 #' @param top Limit number of genesets shown
 #' @param abrv Abbreviation length of genesetlabels
-#' @param sizes Size dots by geneset sizes
+#' @param size_by Size dots by e.g. c("genesets", "significance", "none")
 #' @param pval_cutoff Filter results to be less than pval cutoff
 #' @param fdr_cutoff Filter results to be less than fdr cutoff
 #' @param val Choose significance value e.g. c("fdr", "pval")
@@ -13,20 +13,22 @@
 #' @importFrom reshape2 melt
 #' @importFrom magrittr %>% set_colnames
 #' @importFrom dplyr filter select
+#' @importFrom scales log10_trans
 #' @importFrom ggplot2 ggplot aes geom_point labs scale_color_continuous scale_size_continuous guides theme element_text element_blank
 #' 
 #' @keywords internal
 .dots_multi_plot <- function(multihyp_data,
                              top=20,
                              abrv=50,
-                             sizes=TRUE,
+                             size_by=c("genesets", "significance", "none"),
                              pval_cutoff=1, 
                              fdr_cutoff=1,
                              val=c("fdr", "pval"),
                              title="") {
 
     # Default arguments
     val <- match.arg(val)
+    size_by <- match.arg(size_by)
 
     # Count significant genesets across signatures
     multihyp_dfs <- lapply(multihyp_data, function(hyp_obj) {
@@ -73,27 +75,52 @@
 
     df.melted <- reshape2::melt(as.matrix(df))
     colnames(df.melted) <- c("label", "signature", "significance")
-    df.melted$size <- if(sizes) df.melted$significance else 1
+    df.melted$size <- 1
 
-    df.melted %>%
+    if (size_by == "significance") {
+        df.melted$size <- df.melted$significance
+    }
+
+    if (size_by == "genesets") {
+        geneset.sizes <- lapply(multihyp_data, function(hyp_obj) {
+                hyp_obj$data[, c("label", "geneset")]
+            }) %>%
+            do.call(rbind, .) %>%
+            dplyr::distinct(label, .keep_all=TRUE) %>%
+            dplyr::pull(geneset, label)
+        df.melted$size <- geneset.sizes[df.melted$label]
+    }
+
+    p <- df.melted %>%
     dplyr::filter(significance <= cutoff) %>%
     ggplot(aes(x=signature, y=label, color=significance, size=size)) +
     geom_point() +
     scale_color_continuous(low="#114357", high="#E53935", trans=.reverselog_trans(10)) +
-    scale_size_continuous(trans=.reverselog_trans(10), guide="none") +
     labs(title=title, color=color.label) +  
     theme(plot.title=element_text(hjust=0.5),
           axis.title.y=element_blank(),
           axis.title.x=element_blank(),
           axis.text.x=element_text(angle=45, hjust=1))
+
+    if (size_by == "none") {
+        p <- p + guides(size="none")
+    }
+    if (size_by == "significance") {
+        p <- p + scale_size_continuous(trans=.reverselog_trans(10)) + labs(size="Significance")
+    }
+    if (size_by == "genesets") {
+        p <- p + scale_size_continuous(trans=scales::log10_trans()) + labs(size="Genesets\nSize")
+    }
+
+    return(p)
 }
 
 #' Plot top enriched genesets
 #'
 #' @param hyp_df A dataframe from a hyp object
 #' @param top Limit number of genesets shown
 #' @param abrv Abbreviation length of genesetlabels
-#' @param sizes Size dots by geneset sizes
+#' @param size_by Size dots by e.g. c("genesets", "significance", "none")
 #' @param pval_cutoff Filter results to be less than pval cutoff
 #' @param fdr_cutoff Filter results to be less than fdr cutoff
 #' @param val Choose significance value e.g. c("fdr", "pval")
@@ -102,20 +129,22 @@
 #'
 #' @importFrom purrr when
 #' @importFrom dplyr filter
+#' @importFrom scales log10_trans
 #' @importFrom ggplot2 ggplot aes geom_point labs scale_color_continuous scale_y_continuous guide_colorbar coord_flip geom_hline guides theme element_text element_blank
 #' 
 #' @keywords internal
 .dots_plot <- function(hyp_df,
                        top=20,
                        abrv=50,
-                       sizes=TRUE,
+                       size_by=c("genesets", "significance", "none"),
                        pval_cutoff=1, 
                        fdr_cutoff=1,
                        val=c("fdr", "pval"),
                        title="") {
 
     # Default arguments
     val <- match.arg(val)
+    size_by <- match.arg(size_by)
 
     # Subset results
     df <- hyp_df %>%
@@ -128,7 +157,14 @@
 
     # Plotting variables
     df$significance <- df[,val]
-    df$size <- if(sizes) df$geneset else 1
+    df$size <- 1
+
+    if (size_by == "significance") {
+        df$size <- df$significance
+    }
+    if (size_by == "genesets") {
+        df$size <- df$geneset
+    }
 
     # Order by significance value
     df <- df[order(-df[,val]),]
@@ -148,24 +184,35 @@
         color.label <- "FDR"
     }
 
-    ggplot(df, aes(x=label.abrv, y=significance, color=significance, size=log10(size))) +
+    p <- ggplot(df, aes(x=label.abrv, y=significance, color=significance, size=size)) +
     geom_point() +
     labs(title=title, y=color.label, color=color.label) +
     scale_color_continuous(low="#E53935", high="#114357", guide=guide_colorbar(reverse=TRUE)) +
     coord_flip() +
     scale_y_continuous(trans=.reverselog_trans(10)) +
     geom_hline(yintercept=0.05, linetype="dotted") +
-    guides(size="none") + 
     theme(plot.title=element_text(hjust=0.5),
           axis.title.y=element_blank())
+
+    if (size_by == "none") {
+        p <- p + guides(size="none")
+    }
+    if (size_by == "significance") {
+        p <- p + scale_size_continuous(trans=.reverselog_trans(10)) + labs(size="Significance")
+    }
+    if (size_by == "genesets") {
+        p <- p + scale_size_continuous(trans=scales::log10_trans()) + labs(size="Genesets\nSize")
+    }
+
+    return(p)
 }
 
 #' Visualize hyp/multihyp objects as a dots plot
 #'
 #' @param hyp_obj A hyp or multihyp object
 #' @param top Limit number of genesets shown
 #' @param abrv Abbreviation length of geneset labels
-#' @param sizes Size dots by geneset sizes (if merge=TRUE, size dots by significance)
+#' @param size_by Size dots by e.g. c("genesets", "significance", "none")
 #' @param pval Filter results to be less than pval cutoff
 #' @param fdr Filter results to be less than fdr cutoff
 #' @param val Choose significance value for plot e.g. c("fdr", "pval")
@@ -188,7 +235,7 @@
 hyp_dots <- function(hyp_obj,
                      top=20,
                      abrv=50,
-                     sizes=TRUE,
+                     size_by=c("genesets", "significance", "none"),
                      pval=1, 
                      fdr=1,
                      val=c("fdr", "pval"), 
@@ -199,14 +246,15 @@ hyp_dots <- function(hyp_obj,
 
     # Default arguments
     val <- match.arg(val)
-
+    size_by <- match.arg(size_by)
+
     # Handling of multiple signatures
     if (is(hyp_obj, "multihyp")) {
         multihyp_obj <- hyp_obj
 
-        # Merge multple signatures into a single plot
+        # Merge multiple signatures into a single plot
         if (merge) {
-            .dots_multi_plot(multihyp_obj$data, top, abrv, sizes, pval, fdr, val, title)
+            .dots_multi_plot(multihyp_obj$data, top, abrv, size_by, pval, fdr, val, title)
         } 
         # Return a list of plots for each signature
         else {
@@ -215,7 +263,7 @@ hyp_dots <- function(hyp_obj,
                 hyp_dots(hyp_obj,
                          top=top,
                          abrv=abrv,
-                         sizes=sizes,
+                         size_by=size_by,
                          pval=pval,
                          fdr=fdr,
                          val=val,
@@ -225,6 +273,6 @@ hyp_dots <- function(hyp_obj,
         }
     } 
     else {
-        .dots_plot(hyp_obj$data, top, abrv, sizes, pval, fdr, val, title)
+        .dots_plot(hyp_obj$data, top, abrv, size_by, pval, fdr, val, title)
     }
 }