Nothing
#' Visualize a multi-level network (using ggraph)
#'
#' Visualize a multi-level network, with the possibility of specifying separate
#' layouts for each level. This is a somewhat hacky wrapper for arranging
#' separate ggraph calls for each network level in a circle.
#'
#' For more extensive visualization options, it is recommended to explore the
#' \link[graphlayouts]{layout_as_multilevel} function included in
#' the package graphlayouts.
#'
#' @param net A tidygraph, igraph or statnet network object
#' @param lvl_attr The name of the categorical node attribute specifying at
#' which level a node is situated
#' @param layouts A list of layouts (see \code{ggraph::layout_ggraph}) for every level
#' e.g. for two levels \code{list("auto","circle")}
#' @param label logical - should nodes be labelled? (defaults to false)
#' @param directed whether the network object shall be interpreted as directed
#' network. Per default, \code{motifr::is.directed} is used to determine that.
#' @param nodesize The size of node displays, if displayed as points (if label = false)
#' @param edgewidth The width of lines illustrating edges
#'
#' @return A ggraph object
#' @export
#'
#' @examples
#' plot_mnet(net = motifr::ml_net, lvl_attr = "sesType", layouts = list("kk", "circle"))
plot_mnet <- function(net,
lvl_attr = c("sesType"),
layouts = rep("kk", n_levels),
label = FALSE,
directed = NULL,
nodesize = 3,
edgewidth = 0.5) {
if (network::is.network(net)) {
net <- intergraph::asIgraph(net)
net <-
igraph::set.vertex.attribute(net,
name = "name", value =
igraph::get.vertex.attribute(net, "vertex.names")
)
}
t_g <- tidygraph::as_tbl_graph(net)
nodes <- tibble::as_tibble(tidygraph::activate(t_g, nodes))
edges <- tibble::as_tibble(tidygraph::activate(t_g, edges))
colnames(nodes)[colnames(nodes) == lvl_attr] <- "lvl"
# ensure numeric and starting at 1
nodes$lvl_n <- as.numeric(factor(nodes$lvl))
n_levels <- length(unique(nodes$lvl_n))
edges$to_level <- nodes$lvl_n[edges$to]
edges$from_level <- nodes$lvl_n[edges$from]
edges$between <- ifelse(edges$from_level != edges$to_level, "between", "within")
edges$level_pairs <- apply(data.frame(t(apply(cbind(edges$from_level, edges$to_level), 1, sort))),
1, paste,
collapse = "_"
)
# set edge colors here already
edges$edgecol <- "gray"
within_cols <- RColorBrewer::brewer.pal(n_levels + 2, "Paired") #+2 to avoid R brewer warnings if n < 3
edges$edgecol[edges$between == "within"] <- within_cols[edges$from_level[edges$between == "within"]]
t_g <- tidygraph::tbl_graph(nodes = nodes, edges = edges)
# separate subgraphs
sub_g_list <- vector(mode = "list", length = length(unique(nodes$lvl_n)))
for (level in 1:n_levels) {
#' @importFrom rlang .data
t_g_sub <- tidygraph::to_subgraph(t_g, .data$lvl_n == level, subset_by = "nodes")$subgraph
# if graph has no edges (bug in igraph), create self_loop to have one (hacky)
if (nrow(tibble::as_tibble(tidygraph::activate(t_g_sub, edges))) == 0) {
disc_edges <- tibble::as_tibble(tidygraph::activate(t_g_sub, edges))
disc_nodes <- tibble::as_tibble(tidygraph::activate(t_g_sub, nodes))
disc_edges <- dplyr::bind_rows(disc_edges, tibble::tibble(to = 1, from = 1, between = NA))
t_g_sub <- tidygraph::tbl_graph(nodes = disc_nodes, edges = disc_edges)
}
sub_g_list[[level]] <- ggraph::ggraph(graph = t_g_sub, layout = layouts[[level]]) +
ggraph::geom_edge_loop()
}
# compute x and y offsets
# When arranging n points on a circle, the k-th point, k = 0, …, n-1, has coordinates
# x = cos(2 * pi * k /n) and y = sin(2 * pi * k/n). This gives coordinates ranging from -1 to 1.
coord_offset <- lapply(c(1:n_levels), function(level) {
x <- cos(2 * pi * level / n_levels)
y <- sin(2 * pi * level / n_levels)
return(list(x = x, y = y))
})
for (level in 1:n_levels) {
sub_g_list[[level]][["data"]][["x"]] <- scales::rescale(sub_g_list[[level]][["data"]][["x"]],
to = c(0, 1)
) +
coord_offset[[level]][["x"]]
sub_g_list[[level]][["data"]][["y"]] <- scales::rescale(sub_g_list[[level]][["data"]][["y"]],
to = c(0, 1)
) +
coord_offset[[level]][["y"]]
}
p_comb <- ggraph::ggraph(t_g, layout = "kk")
for (level in 1:n_levels) {
p_comb[["data"]][["x"]][
p_comb[["data"]][["lvl_n"]] == level
] <-
sub_g_list[[level]][["data"]][["x"]]
p_comb[["data"]][["y"]][
p_comb[["data"]][["lvl_n"]] == level
] <-
sub_g_list[[level]][["data"]][["y"]]
}
# render edges (first, because of overplotting nodes later)
# handle directed networks
if ((is.null(directed) && motifr::is.directed(net)) ||
(!is.null(directed) && directed == TRUE)) {
p_comb <- p_comb +
ggraph::geom_edge_link(ggplot2::aes_(
colour = ~edgecol
),
end_cap = ggraph::circle(3, "mm"),
start_cap = ggraph::circle(3, "mm"),
arrow = grid::arrow(
angle = 30,
length = ggplot2::unit(.3, "cm"),
type = "closed"
),
width = edgewidth
)
# +
# ggraph::scale_edge_color_grey(guide = FALSE)
}
else {
p_comb <- p_comb +
ggraph::geom_edge_link(ggplot2::aes_(
colour = ~edgecol
),
width = edgewidth
)
# +
# ggraph::scale_edge_color_grey(guide = FALSE)
}
# render nodes
if (label == FALSE) {
p_comb <-
p_comb +
ggraph::geom_node_point(ggplot2::aes_(color = ~ factor(lvl)), size = nodesize) +
ggplot2::scale_color_brewer("Level",
breaks = levels(factor(nodes$lvl)),
palette = "Paired"
)
}
if (label == TRUE) {
p_comb <-
p_comb + ggraph::geom_node_label(ggplot2::aes_(label = ~name, fill = ~ factor(lvl)),
alpha = 0.5
) +
ggplot2::scale_fill_brewer("Level",
breaks = levels(factor(nodes$lvl)),
palette = "Paired"
)
}
p_comb <- p_comb +
ggplot2::theme_void() +
ggplot2::coord_cartesian(clip = "off") +
ggplot2::theme(legend.position = "bottom")
return(p_comb + ggplot2::theme(plot.margin = ggplot2::unit(c(1, 1, 1, 1), "cm")))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.