Skip to content

Add msig as enrich db option #62

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: devel
Choose a base branch
from
Open

Add msig as enrich db option #62

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
d76e3a5
add limma2df and shake_gsvaResult functions
thomas-keller Jan 10, 2025
1c716e6
initial changes to allow for msig as enrich db
thomas-keller Jan 10, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 44 additions & 22 deletions R/GeneTonic-extras.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
#' the components of the list should have.
#' For backwards compatibility, the `GeneTonic_list` function is still provided
#' as a synonim, and will likely be deprecated in the upcoming release cycles.
#'
#'
#' @param dds A `DESeqDataSet` object, normally obtained after running your data
#' through the `DESeq2` framework.
#' @param res_de A `DESeqResults` object. As for the `dds` parameter, this is
Expand Down Expand Up @@ -193,12 +193,12 @@ describe_gtl <- function(gtl) {
#' go_2_html("GO:0043368")
go_2_html <- function(go_id,
res_enrich = NULL) {
.Deprecated(old = "go_2_html", new = "mosdef::go_to_html",
.Deprecated(old = "go_2_html", new = "mosdef::go_to_html",
msg = paste0(
"Please use `mosdef::go_to_html()` in replacement of the `go_2_html()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::go_to_html()` to see the details on how to use it"))

mycontent <- mosdef::go_to_html(go_id = go_id,
res_enrich = res_enrich)
return(mycontent)
Expand All @@ -211,12 +211,12 @@ go_2_html <- function(go_id,
#' @return HTML for an action button
#' @noRd
.link2amigo <- function(val) {
.Deprecated(old = ".link2amigo", new = "mosdef::create_link_GO",
.Deprecated(old = ".link2amigo", new = "mosdef::create_link_GO",
msg = paste0(
"Please use `mosdef::create_link_GO()` in replacement of the `.link2amigo()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::create_link_GO()` to see the details on how to use it"))

mosdef::create_link_GO(val = val)
}

Expand All @@ -243,15 +243,15 @@ go_2_html <- function(go_id,
#' geneinfo_2_html("Pf4")
geneinfo_2_html <- function(gene_id,
res_de = NULL) {
.Deprecated(old = "geneinfo_2_html", new = "mosdef::geneinfo_to_html",
.Deprecated(old = "geneinfo_2_html", new = "mosdef::geneinfo_to_html",
msg = paste0(
"Please use `mosdef::geneinfo_to_html()` in replacement of the `geneinfo_2_html()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::geneinfo_to_html()` to see the details on how to use it"))

mycontent <- mosdef::geneinfo_to_html(gene_id = gene_id,
res_de = res_de)

return(mycontent)
}

Expand All @@ -262,12 +262,12 @@ geneinfo_2_html <- function(gene_id,
#' @return HTML for an action button
#' @noRd
.link2ncbi <- function(val) {
.Deprecated(old = ".link2ncbi", new = "mosdef::create_link_NCBI",
.Deprecated(old = ".link2ncbi", new = "mosdef::create_link_NCBI",
msg = paste0(
"Please use `mosdef::create_link_NCBI()` in replacement of the `.link2ncbi()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::create_link_NCBI()` to see the details on how to use it"))

mosdef::create_link_NCBI(val = val)
}

Expand All @@ -278,12 +278,12 @@ geneinfo_2_html <- function(gene_id,
#' @return HTML for an action button
#' @noRd
.link2genecards <- function(val) {
.Deprecated(old = ".link2genecards", new = "mosdef::create_link_GeneCards",
.Deprecated(old = ".link2genecards", new = "mosdef::create_link_GeneCards",
msg = paste0(
"Please use `mosdef::create_link_GeneCards()` in replacement of the `.link2genecards()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::create_link_GeneCards()` to see the details on how to use it"))

mosdef::create_link_GeneCards(val = val)
}

Expand All @@ -294,12 +294,12 @@ geneinfo_2_html <- function(gene_id,
#' @return HTML for an action button
#' @noRd
.link2gtex <- function(val) {
.Deprecated(old = ".link2gtex", new = "mosdef::create_link_GTEX",
.Deprecated(old = ".link2gtex", new = "mosdef::create_link_GTEX",
msg = paste0(
"Please use `mosdef::create_link_GTEX()` in replacement of the `.link2gtex()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::create_link_GTEX()` to see the details on how to use it"))

mosdef::create_link_GTEX(val = val)
}

Expand Down Expand Up @@ -463,18 +463,18 @@ overlap_jaccard_index <- function(x, y) {
styleColorBar_divergent <- function(data,
color_pos,
color_neg) {
.Deprecated(old = "styleColorBar_divergent", new = "mosdef::styleColorBar_divergent",
.Deprecated(old = "styleColorBar_divergent", new = "mosdef::styleColorBar_divergent",
msg = paste0(
"Please use `mosdef::styleColorBar_divergent()` in replacement of the `styleColorBar_divergent()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::styleColorBar_divergent()` to see the details on how to use it"))

code_ret <- mosdef::styleColorBar_divergent(
data = data,
color_pos = color_pos,
color_neg = color_neg
)

return(code_ret)
}

Expand Down Expand Up @@ -511,13 +511,13 @@ styleColorBar_divergent <- function(data,
#' )(50)
#' plot(b, col = map2color(b, pal2), pch = 20, cex = 3)
map2color <- function(x, pal, symmetric = TRUE, limits = NULL) {
.Deprecated(old = "map2color", new = "mosdef::map_to_color",
.Deprecated(old = "map2color", new = "mosdef::map_to_color",
msg = paste0(
"Please use `mosdef::map_to_color()` in replacement of the `map2color()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::map_to_color()` to see the details on how to use it"))
pal_ret <- map_to_color(x = x,

pal_ret <- map_to_color(x = x,
pal = pal,
symmetric = symmetric,
limits = limits)
Expand Down Expand Up @@ -578,12 +578,12 @@ check_colors <- function(x) {
#' res_df <- mosdef::deresult_to_df(res_macrophage_IFNg_vs_naive)
#' head(res_df)
deseqresult2df <- function(res_de, FDR = NULL) {
.Deprecated(old = "deseqresult2df", new = "mosdef::deresult_to_df",
.Deprecated(old = "deseqresult2df", new = "mosdef::deresult_to_df",
msg = paste0(
"Please use `mosdef::deresult_to_df()` in replacement of the `deseqresult2df()` function, ",
"originally located in the GeneTonic package. \nCheck the manual page for ",
"`?mosdef::deresult_to_df()` to see the details on how to use it"))

df <- mosdef::deresult_to_df(res_de = res_de,
FDR = FDR)
return(df)
Expand Down Expand Up @@ -645,6 +645,26 @@ editor_to_vector_sanitized <- function(txt) {
sub(" +$", "", rn)
}

#' convert limma results to dataframe with DESeq column names
#'
#' @param res_de limma toptable results
#' @param FDR false discovery rate cutoff
#'
#' @return dataframe with deseq-like result column names
#' @export
#'
#' @examples TODO
limma2df<-function(res_de,FDR=NULL){
res<- cbind(rownames(res_de),res_de)
names(res)[c(1,2,6)]=c('id','log2FoldChange','padj')
res$id=as.character(res$id)
res=res[order(res$padj),]
if(!is.null(FDR)){
res=res[!is.na(res$padj) & res$padj<=FDR,]
}
return(res)
}

GeneTonic_footer <- fluidRow(
column(
width = 1,
Expand All @@ -669,6 +689,8 @@ GeneTonic_footer <- fluidRow(
)
)



# Shiny resource paths ----------------------------------------------------

.onLoad <- function(libname, pkgname) {
Expand Down
35 changes: 19 additions & 16 deletions R/enhance_table.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@
#' available in `res_enrich`. Lists the gene sets to be displayed.
#' @param chars_limit Integer, number of characters to be displayed for each
#' geneset name.
#' @param plot_style Character value, one of "point" or "ridgeline". Defines the
#' @param plot_style Character value, one of "point" or "ridgeline". Defines the
#' style of the plot to summarize visually the table.
#' @param ridge_color Character value, one of "gs_id" or "gs_score", controls the
#' fill color of the ridge lines. If selecting "gs_score", the `z_score` column
Expand Down Expand Up @@ -69,7 +69,7 @@
#' anno_df,
#' n_gs = 10
#' )
#'
#'
#' # using the ridge line as a style, also coloring by the Z score
#' res_enrich_withscores <- get_aggrscores(
#' res_enrich,
Expand All @@ -79,7 +79,7 @@
#' enhance_table(res_enrich_withscores,
#' res_de,
#' anno_df,
#' n_gs = 10,
#' n_gs = 10,
#' plot_style = "ridgeline",
#' ridge_color = "gs_score"
#' )
Expand All @@ -100,10 +100,10 @@ enhance_table <- function(res_enrich,
res_enrich <- gtl$res_enrich
annotation_obj <- gtl$annotation_obj
}

plot_style <- match.arg(plot_style, c("point", "ridgeline"))
ridge_color <- match.arg(ridge_color, c("gs_id", "gs_score"))

n_gs <- min(n_gs, nrow(res_enrich))

gs_to_use <- unique(
Expand All @@ -118,7 +118,7 @@ enhance_table <- function(res_enrich,
genes_thisset <- unlist(strsplit(genes_thisset, ","))

genesid_thisset <- annotation_obj$gene_id[match(genes_thisset, annotation_obj$gene_name)]

# removing the genes not finding a match in the annotation
no_anno_match <- is.na(genesid_thisset)
genes_thisset_anno <- genes_thisset[!no_anno_match]
Expand All @@ -131,7 +131,7 @@ enhance_table <- function(res_enrich,
" the gene(s) named: ",
paste0(genes_thisset[no_anno_match], collapse = ", "))
}

res_thissubset <- res_de[genesid_thisset_anno, ]

res_thissubset <- as.data.frame(res_thissubset)
Expand All @@ -145,8 +145,11 @@ enhance_table <- function(res_enrich,
gs_fulllist <- do.call(rbind, gs_fulllist)
# message(dim(gs_fulllist)[1])

if(class(res_de)=="DESeqResults"){
this_contrast <- (sub(".*p-value: (.*)", "\\1", mcols(res_de, use.names = TRUE)["pvalue", "description"]))

} else{
this_contrast <- ""
}
# to have first rows viewed on top
gs_fulllist <- gs_fulllist[rev(seq_len(nrow(gs_fulllist))), ]
gs_fulllist$gs_desc <- factor(gs_fulllist$gs_desc, levels = rev(levels(gs_fulllist$gs_desc)))
Expand All @@ -157,7 +160,7 @@ enhance_table <- function(res_enrich,
substr(as.character(unique(gs_fulllist$gs_desc)), 1, chars_limit),
" | ", unique(gs_fulllist$gs_id)
)

if (plot_style == "point") {
p <- ggplot(
gs_fulllist, aes(
Expand All @@ -177,14 +180,14 @@ enhance_table <- function(res_enrich,
labels = gs_labels
) +
labs(x = "log2 Fold Change")

} else if (plot_style == "ridgeline") {

if (ridge_color == "gs_score" & is.null(res_enrich$z_score)) {
message("Fallback to plotting the ridgelines according to geneset id (Z score required)")
ridge_color <- "gs_id"
}
}

if (ridge_color == "gs_score") {
gs_fulllist$gs_zscore <- res_enrich$z_score[match(gs_fulllist$gs_id, res_enrich$gs_id)]
p <- ggplot(
Expand All @@ -194,8 +197,8 @@ enhance_table <- function(res_enrich,
fill = .data$gs_zscore
)
) +
scale_x_continuous(limits = c(-max_lfc, max_lfc)) +
scale_fill_gradient2(low = "#313695", mid = "#FFFFE5", high = "#A50026") +
scale_x_continuous(limits = c(-max_lfc, max_lfc)) +
scale_fill_gradient2(low = "#313695", mid = "#FFFFE5", high = "#A50026") +
ggridges::geom_density_ridges(
aes(group = .data$gs_id),
point_color = "#00000066",
Expand All @@ -218,7 +221,7 @@ enhance_table <- function(res_enrich,
fill = .data$gs_id
)
) +
scale_x_continuous(limits = c(-max_lfc, max_lfc)) +
scale_x_continuous(limits = c(-max_lfc, max_lfc)) +
ggridges::geom_density_ridges(
aes(group = .data$gs_id),
point_color = "#00000066",
Expand Down
27 changes: 20 additions & 7 deletions R/ggs_graph.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,9 @@ ggs_graph <- function(res_enrich,

enriched_gsids <- res_enrich[["gs_id"]]
enriched_gsnames <- res_enrich[["gs_description"]]
if("gs_fulldesc" %in% colnames(res_enrich)){
enriched_gsdescs <- res_enrich[['gs_fulldesc']]
} else{
enriched_gsdescs <- vapply(
enriched_gsids,
function(arg) {
Expand All @@ -133,7 +136,7 @@ ggs_graph <- function(res_enrich,
)
},
character(1)
)
)}

gs_to_use <- unique(
c(
Expand Down Expand Up @@ -193,9 +196,19 @@ ggs_graph <- function(res_enrich,

# title for tooltips
V(g)$title <- NA
#not sure best way to test for GO vs other database - also link only works if msig
#could have link as an optional column like gs_fulldesc in res_enrich?
if("gs_fulldesc" %in% colnames(res_enrich)){
link_gs<- sprintf('<a href="https://www.gsea-msigdb.org/gsea/msigdb/human/geneset/%s.html" target="_blank">%s</a>',
enriched_gsnames[nodeIDs_gs], enriched_gsids[nodeIDs_gs])
} else{
link_gs <- sprintf('<a href="http://amigo.geneontology.org/amigo/term/%s" target="_blank">%s</a>',
enriched_gsids[nodeIDs_gs], enriched_gsids[nodeIDs_gs])
}

V(g)$title[nodeIDs_gs] <- paste0(
"<h4>",
sprintf('<a href="http://amigo.geneontology.org/amigo/term/%s" target="_blank">%s</a>', enriched_gsids[nodeIDs_gs], enriched_gsids[nodeIDs_gs]), "</h4><br>",
link_gs, "</h4><br>",
V(g)$name[nodeIDs_gs], "<br><br>",
sapply(enriched_gsdescs[nodeIDs_gs],
function(x) paste0(strwrap(x, 50), collapse='<br>'))
Expand Down Expand Up @@ -444,7 +457,7 @@ ggs_backbone <- function(res_enrich,
limits = range(na.omit(col_var)))
V(bbgraph)$color.hover <- mosdef::map_to_color(col_var, mypal_hover, symmetric = TRUE,
limits = range(na.omit(col_var)))

V(bbgraph)$color.background[is.na(V(bbgraph)$color.background)] <- "lightgrey"
V(bbgraph)$color.highlight[is.na(V(bbgraph)$color.highlight)] <- "lightgrey"
V(bbgraph)$color.hover[is.na(V(bbgraph)$color.hover)] <- "lightgrey"
Expand All @@ -469,17 +482,17 @@ ggs_backbone <- function(res_enrich,
colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 1
))

V(bbgraph)$color.background <- mosdef::map_to_color(col_var, mypal,
V(bbgraph)$color.background <- mosdef::map_to_color(col_var, mypal,
limits = range(na.omit(col_var)))
V(bbgraph)$color.highlight <- mosdef::map_to_color(col_var, mypal_select,
V(bbgraph)$color.highlight <- mosdef::map_to_color(col_var, mypal_select,
limits = range(na.omit(col_var)))
V(bbgraph)$color.hover <- mosdef::map_to_color(col_var, mypal_hover,
V(bbgraph)$color.hover <- mosdef::map_to_color(col_var, mypal_hover,
limits = range(na.omit(col_var)))

V(bbgraph)$color.background[is.na(V(bbgraph)$color.background)] <- "lightgrey"
V(bbgraph)$color.highlight[is.na(V(bbgraph)$color.highlight)] <- "lightgrey"
V(bbgraph)$color.hover[is.na(V(bbgraph)$color.hover)] <- "lightgrey"

V(bbgraph)$color.border <- "black"

# additional specification of edge colors
Expand Down
Loading
Loading