Skip to content

Commit

Permalink
reconciled sites
Browse files Browse the repository at this point in the history
  • Loading branch information
Stefano Monti committed Sep 18, 2023
2 parents bdb2531 + a74b3b8 commit 0f5ae2e
Show file tree
Hide file tree
Showing 12 changed files with 181 additions and 92 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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="[email protected]",
role=c("aut", "cre")),
person(given="Stefano", family="Monti", email="[email protected]",
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
3 changes: 3 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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

Expand Down
82 changes: 65 additions & 17 deletions R/hyp_dots.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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) {
Expand Down Expand Up @@ -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")
Expand All @@ -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 %>%
Expand All @@ -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]),]
Expand All @@ -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")
Expand All @@ -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"),
Expand All @@ -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 {
Expand All @@ -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,
Expand All @@ -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)
}
}
Loading

0 comments on commit 0f5ae2e

Please sign in to comment.