Skip to content

Commit 9f9fea1

Browse files
tetomontitetomonti
committed
addressing issue #56 
1 parent 9fceb9d commit 9f9fea1

File tree

1 file changed

+91
-92
lines changed

1 file changed

+91
-92
lines changed

‎R/hyp_dots.R

Lines changed: 91 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -18,101 +18,100 @@
1818
#'
1919
#' @keywords internal
2020
.dots_multi_plot <- function(multihyp_data,
21-
top=20,
22-
abrv=50,
23-
size_by=c("genesets", "significance", "none"),
24-
pval_cutoff=1,
25-
fdr_cutoff=1,
26-
val=c("fdr", "pval"),
27-
title="") {
28-
29-
# Default arguments
30-
val <- match.arg(val)
31-
size_by <- match.arg(size_by)
32-
33-
# Count significant genesets across signatures
34-
multihyp_dfs <- lapply(multihyp_data, function(hyp_obj) {
35-
hyp_obj$data %>%
36-
dplyr::filter(pval <= pval_cutoff) %>%
37-
dplyr::filter(fdr <= fdr_cutoff) %>%
38-
dplyr::select(label)
39-
})
40-
41-
# Take top genesets
42-
labels <- names(sort(table(unlist(multihyp_dfs)), decreasing=TRUE))
43-
if (!is.null(top)) labels <- head(labels, top)
44-
45-
# Handle empty dataframes
46-
if (length(labels) == 0) return(ggempty())
47-
48-
# Create a multihyp dataframe
49-
dfs <- lapply(multihyp_data, function(hyp_obj) {
50-
hyp_df <- hyp_obj$data
51-
hyp_df[hyp_df$label %in% labels, c("label", val), drop=FALSE]
52-
})
53-
54-
df <- suppressWarnings(Reduce(function(x, y) merge(x, y, by="label", all=TRUE), dfs))
55-
colnames(df) <- c("label", names(dfs))
56-
rownames(df) <- df$label
57-
df <- df[rev(labels), names(dfs)]
58-
59-
# Abbreviate labels
60-
label.abrv <- substr(rownames(df), 1, abrv)
61-
if (any(duplicated(label.abrv))) {
62-
stop("Non-unique labels after abbreviating")
63-
} else {
64-
rownames(df) <- factor(label.abrv, levels=label.abrv)
65-
}
66-
67-
if (val == "pval") {
68-
cutoff <- pval_cutoff
69-
color.label <- "P-Value"
70-
}
71-
if (val == "fdr") {
72-
cutoff <- fdr_cutoff
73-
color.label <- "FDR"
74-
}
75-
76-
df.melted <- reshape2::melt(as.matrix(df))
77-
colnames(df.melted) <- c("label", "signature", "significance")
78-
df.melted$size <- 1
79-
80-
if (size_by == "significance") {
81-
df.melted$size <- df.melted$significance
82-
}
83-
84-
if (size_by == "genesets") {
85-
geneset.sizes <- lapply(multihyp_data, function(hyp_obj) {
86-
hyp_obj$data[, c("label", "geneset")]
87-
}) %>%
88-
do.call(rbind, .) %>%
89-
dplyr::distinct(label, .keep_all=TRUE) %>%
90-
dplyr::pull(geneset, label)
91-
df.melted$size <- geneset.sizes[df.melted$label]
92-
}
21+
top = 20,
22+
abrv = 50,
23+
size_by = c("genesets", "significance", "none"),
24+
pval_cutoff = 1,
25+
fdr_cutoff = 1,
26+
val = c("fdr", "pval"),
27+
title = "")
28+
{
29+
# Default arguments
30+
val <- match.arg(val)
31+
size_by <- match.arg(size_by)
32+
33+
# Count significant genesets across signatures
34+
multihyp_dfs <- lapply(multihyp_data, function(hyp_obj) {
35+
hyp_obj$data %>%
36+
dplyr::filter(pval <= pval_cutoff) %>%
37+
dplyr::filter(fdr <= fdr_cutoff) %>%
38+
dplyr::select(label)
39+
})
40+
# Take top genesets
41+
labels <- names(sort(table(unlist(multihyp_dfs)), decreasing = TRUE))
42+
if (!is.null(top)) labels <- head(labels, top)
43+
44+
# Handle empty dataframes
45+
if (length(labels) == 0) {
46+
return(ggempty())
47+
}
48+
# Create a multihyp dataframe
49+
dfs <- lapply(multihyp_data, function(hyp_obj) {
50+
hyp_df <- hyp_obj$data
51+
hyp_df[hyp_df$label %in% labels, c("label", val), drop = FALSE]
52+
})
53+
df <- suppressWarnings(Reduce(function(x, y) merge(x, y, by = "label", all = TRUE), dfs))
54+
colnames(df) <- c("label", names(dfs))
55+
rownames(df) <- df$label
56+
df <- df[rev(labels), names(dfs)]
9357

94-
p <- df.melted %>%
58+
# Abbreviate labels
59+
label.abrv <- substr(rownames(df), 1, abrv)
60+
if (any(duplicated(label.abrv))) {
61+
stop("Non-unique labels after abbreviating")
62+
} else {
63+
rownames(df) <- factor(label.abrv, levels = label.abrv)
64+
}
65+
if (val == "pval") {
66+
cutoff <- pval_cutoff
67+
color.label <- "P-Value"
68+
}
69+
if (val == "fdr") {
70+
cutoff <- fdr_cutoff
71+
color.label <- "FDR"
72+
}
73+
df.melted <- reshape2::melt(as.matrix(df))
74+
colnames(df.melted) <- c("label", "signature", "significance")
75+
df.melted$size <- 1
76+
77+
if (size_by == "significance") {
78+
df.melted$size <- df.melted$significance
79+
}
80+
if (size_by == "genesets") {
81+
geneset.sizes <- lapply(multihyp_data, function(hyp_obj) {
82+
hyp_obj$data[, c("label", "geneset")]
83+
}) %>%
84+
do.call(rbind, .) %>%
85+
dplyr::distinct(label, .keep_all = TRUE) %>%
86+
dplyr::pull(geneset, label)
87+
df.melted$size <- geneset.sizes[df.melted$label]
88+
}
89+
p <- df.melted %>%
9590
dplyr::filter(significance <= cutoff) %>%
96-
ggplot(aes(x=signature, y=label, color=significance, size=size)) +
91+
ggplot(aes(x = signature, y = label, color = significance, size = size)) +
9792
geom_point() +
98-
scale_color_continuous(low="#114357", high="#E53935", trans=.reverselog_trans(10)) +
99-
labs(title=title, color=color.label) +
100-
theme(plot.title=element_text(hjust=0.5),
101-
axis.title.y=element_blank(),
102-
axis.title.x=element_blank(),
103-
axis.text.x=element_text(angle=45, hjust=1))
104-
105-
if (size_by == "none") {
106-
p <- p + guides(size="none")
107-
}
108-
if (size_by == "significance") {
109-
p <- p + scale_size_continuous(trans=.reverselog_trans(10)) + labs(size="Significance")
110-
}
111-
if (size_by == "genesets") {
112-
p <- p + scale_size_continuous(trans=scales::log10_trans()) + labs(size="Genesets\nSize")
113-
}
114-
115-
return(p)
93+
scale_color_continuous(low = "#114357", high = "#E53935", trans = .reverselog_trans(10)) +
94+
labs(title = title, color = color.label) +
95+
theme(
96+
plot.title = element_text(hjust = 0.5),
97+
axis.title.y = element_blank(),
98+
axis.title.x = element_blank(),
99+
axis.text.x = element_text(angle = 45, hjust = 1)
100+
)
101+
if (size_by == "none") {
102+
p <- p + guides(size = "none")
103+
}
104+
if (size_by == "significance") {
105+
p <- p + scale_size_continuous(trans = .reverselog_trans(10)) + labs(size = "Significance")
106+
}
107+
if (size_by == "genesets") {
108+
#p <- p + scale_size_continuous(trans = scales::log10_trans()) + labs(size = "Genesets\nSize")
109+
p <- p + scale_color_continuous(
110+
high = "#114357", low = "#E53935", trans = scales::log10_trans(),
111+
guide = guide_colorbar(reverse = TRUE)
112+
)
113+
}
114+
return(p)
116115
}
117116

118117
#' Plot top enriched genesets

0 commit comments

Comments
 (0)