Skip to content

Commit

Permalink
Revising Bioc review
Browse files Browse the repository at this point in the history
  • Loading branch information
@noriakis
noriakis committed Aug 21, 2023
1 parent 260ec0b commit 81ff400
Show file tree
Hide file tree
Showing 7 changed files with 806 additions and 802 deletions.
160 changes: 82 additions & 78 deletions R/ggkegg.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,10 @@
#' @param numeric_attribute named vector for appending numeric attribute
#' @param node_rect_nudge parameter for nudging the node rect
#' @param group_rect_nudge parameter for nudging the group node rect
#' @example
#' ## Use pathway ID to obtain `ggraph` object directly.
#' g <- ggkegg("hsa04110")
#' g + geom_node_rect()
#' @import ggraph
#' @import ggplot2
#' @importFrom tidygraph as_tbl_graph
Expand Down Expand Up @@ -112,52 +116,52 @@ ggkegg <- function(pid,

V(g)$converted_name <- unlist(lapply(V(g)$name,
function(x) {
inc_genes <- unlist(strsplit(x, " "))
conv_genes <- vapply(inc_genes, function(inc) {
inc_genes <- unlist(strsplit(x, " "))
conv_genes <- vapply(inc_genes, function(inc) {
convs <- convert_vec[inc]
if (is.na(convs)) {
return(x)
} else {
return(convs)
}
}, FUN.VALUE="a")
if (convert_first) {
conv_genes[1]
} else {
paste(conv_genes, collapse=convert_collapse)
}
if (convert_first) {
conv_genes[1]
} else {
paste(conv_genes, collapse=convert_collapse)
}
}
))
}

if (!is.null(numeric_attribute)){
V(g)$numeric_attribute <- numeric_attribute[V(g)$name]
}
V(g)$numeric_attribute <- numeric_attribute[V(g)$name]
}

if (!is.null(enrich_attribute)) {
bools <- vapply(V(g)$name, function(xx) {
bools <- vapply(V(g)$name, function(xx) {
in_node <- strsplit(xx, " ") |> unlist() |> unique()
if (length(intersect(in_node, enrich_attribute)) >= 1) { ## Only `any`
return(TRUE)
} else {
return(FALSE)
}
}, FUN.VALUE=TRUE)
V(g)$enrich_attribute <- bools
}
V(g)$enrich_attribute <- bools
}

if (delete_undefined) {
g <- induced.subgraph(g, !V(g)$name %in% "undefined")
} else {
V(g)$undefined <- V(g)$name %in% "undefined"
}
if (delete_zero_degree) {
g <- induced.subgraph(g, degree(g)!=0)
}
g <- induced.subgraph(g, !V(g)$name %in% "undefined")
} else {
V(g)$undefined <- V(g)$name %in% "undefined"
}
if (delete_zero_degree) {
g <- induced.subgraph(g, degree(g)!=0)
}

if (convert_reaction) {
convert_vec <- obtain_map_and_cache("reaction",NULL)
V(g)$converted_reaction <- unlist(lapply(V(g)$reaction,
convert_vec <- obtain_map_and_cache("reaction",NULL)
V(g)$converted_reaction <- unlist(lapply(V(g)$reaction,
function(x) {
inc_genes <- unlist(strsplit(x, " "))
conv_genes <- vapply(inc_genes, function(inc) {
Expand All @@ -178,17 +182,17 @@ ggkegg <- function(pid,
}

if (return_tbl_graph) {
return(as_tbl_graph(g))
}
return(as_tbl_graph(g))
}
if (return_igraph) {
return(g)
return(g)
}
if (layout == "native") {
ggraph(g, layout="manual", x=.data$x, y=.data$y)
ggraph(g, layout="manual", x=.data$x, y=.data$y)
} else {
g <- delete_vertex_attr(g, "x")
g <- delete_vertex_attr(g, "y")
ggraph(g, layout=layout)
g <- delete_vertex_attr(g, "x")
g <- delete_vertex_attr(g, "y")
ggraph(g, layout=layout)
}
}

Expand Down Expand Up @@ -303,60 +307,60 @@ rawMap <- function(enrich, pathway_number=1, pid=NULL,
rawValue <- function(values, pid=NULL, column="name", show_type="gene",
how="any", white_background=TRUE, auto_add=FALSE, man_graph=NULL) {
if (is.list(values)) {
number <- length(values)
if (auto_add) {
pref <- gsub("[^a-zA-Z]", "", pid)
for (i in seq_along(values)) {
names(values[[i]]) <- paste0(pref, ":", names(values[[i]]))
}
}
} else {
number <- 1
if (auto_add) {
pref <- gsub("[^a-zA-Z]", "", pid)
names(values) <- paste0(pref, ":", names(values))
}
}
if (!is.null(man_graph)) {
pgraph <- man_graph
number <- length(values)
if (auto_add) {
pref <- gsub("[^a-zA-Z]", "", pid)
for (i in seq_along(values)) {
names(values[[i]]) <- paste0(pref, ":", names(values[[i]]))
}
}
} else {
number <- 1
if (auto_add) {
pref <- gsub("[^a-zA-Z]", "", pid)
names(values) <- paste0(pref, ":", names(values))
}
}
if (!is.null(man_graph)) {
pgraph <- man_graph
} else {
pgraph <- pathway(pid)
pgraph <- pathway(pid)
}
if (number == 1) {
g <- pgraph |> mutate(value=node_numeric(values,
name=column, how=how))
gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)+
geom_node_rect(aes(fill=.data$value,
filter=.data$type %in% show_type))+
overlay_raw_map()+theme_void()
g <- pgraph |> mutate(value=node_numeric(values,
name=column, how=how))
gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)+
geom_node_rect(aes(fill=.data$value,
filter=.data$type %in% show_type))+
overlay_raw_map()+theme_void()
} else {
## Add new scales like ggh4x
g <- pgraph
for (i in seq_len(number)) {
g <- g |> mutate(!!paste0("value",i):=node_numeric(values[[i]],
name=column,how=how))
}
V(g)$space <- V(g)$width/number
gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)
nds <- g |> activate("nodes") |> data.frame()
nds <- nds[nds$type %in% show_type,]
## Add new scales like ggh4x
g <- pgraph
for (i in seq_len(number)) {
g <- g |> mutate(!!paste0("value",i):=node_numeric(values[[i]],
name=column,how=how))
}
V(g)$space <- V(g)$width/number
gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)
nds <- g |> activate("nodes") |> data.frame()
nds <- nds[nds$type %in% show_type,]

for (i in seq_len(number)) {
nudge <- i-1
for (i in seq_len(number)) {
nudge <- i-1

gg <- gg + geom_node_rect(
aes(fill=!!sym(paste0("value",i)),
filter=.data$type %in% show_type),
xmin=nds$xmin+nds$space*nudge,
xmax=nds$xmin+i*nds$space
)
}
gg <- gg + overlay_raw_map()+theme_void()
}
if (white_background) {
gg + theme(panel.background = element_rect(fill = 'white',
colour = 'white'))
} else {
gg
}
gg <- gg + geom_node_rect(
aes(fill=!!sym(paste0("value",i)),
filter=.data$type %in% show_type),
xmin=nds$xmin+nds$space*nudge,
xmax=nds$xmin+i*nds$space
)
}
gg <- gg + overlay_raw_map()+theme_void()
}
if (white_background) {
gg + theme(panel.background = element_rect(fill = 'white',
colour = 'white'))
} else {
gg
}
}
26 changes: 13 additions & 13 deletions R/highlight_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,16 @@ highlight_set_nodes <- function(set, how="all",
graph <- .G()
x <- get.vertex.attribute(graph, name)
vec <- vapply(seq_along(x), function(xn) {
if (no_sep) {
nn <- x[xn]
if (no_sep) {
nn <- x[xn]
} else {
nn <- unlist(strsplit(x[xn], sep))
}
if (how == "all") {
if (length(intersect(nn, set)) == length(nn)) {
return(TRUE)
} else {
return(FALSE)
return(TRUE)
} else {
return(FALSE)
}
} else {
if (length(intersect(nn, set)) >= 1) {
Expand Down Expand Up @@ -71,16 +71,16 @@ highlight_set_edges <- function(set, how="all",
graph <- .G()
x <- get.edge.attribute(graph, name)
vec <- vapply(seq_along(x), function(xn) {
if (no_sep) {
nn <- x[xn]
if (no_sep) {
nn <- x[xn]
} else {
nn <- unlist(strsplit(x[xn], sep))
}
if (how == "all") {
if (length(intersect(nn, set)) == length(nn)) {
return(TRUE)
} else {
return(FALSE)
return(TRUE)
} else {
return(FALSE)
}
} else {
if (length(intersect(nn, set)) >= 1) {
Expand Down Expand Up @@ -143,7 +143,7 @@ highlight_module <- function(graph, kmo,

x <- get.edge.attribute(graph, "reaction")
## Store edge index that meet reaction
ind <- lapply(seq_along(x), function(xn) {
ind <- lapply(seq_along(x), function(xn) {
reac <- raw_reac_string
rls <- rep(FALSE, length(reac_list))
names(rls) <- reac_list
Expand Down Expand Up @@ -191,7 +191,7 @@ highlight_module <- function(graph, kmo,
length(intersect(prod,
left)) == length(left))) {
return(list("ind"=xn,
"nind"=c(node1, node2)))
"nind"=c(node1, node2)))
}
}
}
Expand All @@ -200,7 +200,7 @@ highlight_module <- function(graph, kmo,
}) ## each edge
list(lapply(ind, function(x) x[["ind"]]) |> unlist(),
lapply(ind, function(x) x[["nind"]]) |> unlist())
})
})

all_inds <- lapply(results, function(x) x[[1]]) |> unlist()
nind <- lapply(results, function(x) x[[2]]) |> unlist()
Expand Down
Loading

0 comments on commit 81ff400

Please sign in to comment.