Nothing
#' Compare two graphs
#'
#' From two graphs generated by \code{\link{graph_from_matrix}} or
#' \code{\link{graph_from_links_nodes}}, displays two graphs
#' with the same legend (edge weights and size and node degrees)
#' to facilitate the visual comparison of the two graphs.
#' NB : if you use node families, make sure they have the same families
#' in the two graphs (this can be done by generating a same palette for
#' both graphs using \code{\link{family_palette}})
#'
#' @param graph1 : the first graph
#' @param graph2 : the second graph
#' @param titles (optional) : list of 2 : the two title of the graphs.
#' Default are the graph titles from \code{\link{graph_from_matrix}}
#' or \code{\link{graph_from_links_nodes}}.
#' @param position : should the graphs be displayed vertically (use
#' \code{vertical}, default) or horizontally (use \code{horizontal}).
#' @param n_nodes : the number of nodes to be displayed in the legend.
#' R will do its best to be around this number.
#' @param n_weights : the number of weights to be displayed in the legend.
#' R will do its best to be around this number.
#' @param edge_width_range : range of the edges width (default is 0.2 to 2).
#' @param edge_alpha_range : if \code{edge_alpha} is TRUE, the range of the alpha
#' values (between 0 and 1). Default is 0.4 to 1.
#' @param node_size_range : range of the node sizes. (default is 1 to 10)
#' @param unique_legend : should there be a unique legend (default is TRUE)
#' BE CAREFUL to have the same family colors if you use families/
#'
#' @importFrom rlang .data
#' @importFrom labeling extended
#' @import cowplot
#' @import ggplot2
#' @import igraph
#' @import ggraph
#' @export
compare_graphs <- function(graph1,
graph2,
titles = NULL,
position = c("vertical", "horizontal"),
n_nodes = 5,
n_weights = 5,
edge_width_range = c(0.2,2),
edge_alpha_range = c(0.4, 1),
node_size_range = c(1,10),
unique_legend = TRUE) {
if (is.null(graph1$igraph) || is.null(graph1$net) || is.null(graph1$deg) ||
is.null(graph2$igraph) || is.null(graph2$net) || is.null(graph2$deg)) {
stop("Can only compare graphs generated by foodingraph")
}
position <- match.arg(position)
#-----------
# PART 1 : Nodes (degrees)
#-----------
# Determine the appropriate range and breaks for node degree values
graph1_degrees <- degree(graph1$igraph)
graph2_degrees <- degree(graph2$igraph)
range_degrees1 <- c(min(graph1_degrees), max(graph1_degrees))
range_degrees2 <- c(min(graph2_degrees), max(graph2_degrees))
range_degrees <- c(min(range_degrees1, range_degrees2),
max(range_degrees1, range_degrees2))
breaks_degrees <- extended(range_degrees[1], range_degrees[2], n_nodes)
# To remove unexpected behaviour that can show node degrees not rounded
breaks_degrees <- unique(round(breaks_degrees))
#-----------
# PART 2 : Edges (weights and alpha)
#-----------
# Determine the appropriate range and breaks for edge width values
graph1_edges <- E(graph1$igraph)
graph2_edges <- E(graph2$igraph)
range_weights1 <- c(min(graph1_edges$weight), max(graph1_edges$weight))
range_weights2 <- c(min(graph2_edges$weight), max(graph2_edges$weight))
range_weights <- c(min(range_weights1, range_weights2),
max(range_weights1, range_weights2))
breaks_weights <- extended(range_weights[1], range_weights[2], n_weights)
#-----------
# PART 3 : Reconstruct the graphs
#-----------
# Altering the graphs
graph1$net <- suppressMessages(
graph1$net +
# Edge width and alpha
scale_edge_alpha_continuous(name = "Edge weight",
range = edge_alpha_range,
breaks = breaks_weights,
limits = range_weights) +
scale_edge_width_continuous(name = "Edge weight",
range = edge_width_range,
breaks = breaks_weights,
limits = range_weights) +
# Node degree
scale_size_continuous(name = "Node degrees",
range = node_size_range,
breaks = breaks_degrees,
limits = range_degrees)
)
graph2$net <- suppressMessages(
graph2$net +
# Edge width and alpha
scale_edge_alpha_continuous(name = "Edge weight",
range = edge_alpha_range,
breaks = breaks_weights,
limits = range_weights) +
scale_edge_width_continuous(name = "Edge weight",
range = edge_width_range,
breaks = breaks_weights,
limits = range_weights) +
# Node degree
scale_size_continuous(name = "Node degrees",
range = node_size_range,
breaks = breaks_degrees,
limits = range_degrees)
)
#-----------
# PART 4 : Arrange the graphs on a grid
#-----------
if (unique_legend == TRUE && position == "vertical") {
# Case 1 : unique legend, graphs compared vertically
final_graph <- plot_grid(
graph1$net + theme(legend.position = "none"),
graph2$net + theme(legend.position = "none"),
NULL,
ncol = 1,
axis = "lr",
rel_heights = c(1, 1, 0.3),
labels = c(titles[1], "", titles[2])
)
# Retrieve the legend
legend_plot <- get_legend(
graph1$net +
theme(
legend.position = "bottom",
legend.direction = "vertical"
) +
guides(fill = guide_legend(
nrow = 5,
order = 1,
override.aes = list(size = 5))
)
)
# Add the legend to the graphs grid
# 2.3 is the sum of the relative heights
final_graph <- final_graph + draw_grob(legend_plot, 0, 0, 1, .3/2.3)
} else if (unique_legend == TRUE && position == "horizontal") {
# Case 2 : unique legend, graphs compared horizontally
final_graph <- plot_grid(
graph1$net + theme(legend.position = "none"),
NULL,
graph2$net + theme(legend.position = "none"),
ncol = 3,
nrow = 1,
axis = "tb",
rel_widths = c(1, 0.3, 1),
labels = c(titles[1], "", titles[2])
)
# Retrieve the legend
legend_plot <- get_legend(graph1$net)
# Add the legend to the graphs grid
# 2.3 if the sum of the relative widths
final_graph <- final_graph + draw_grob(legend_plot, 1/2.3, 0, .3/2.3, 1)
} else {
# Case 3 and 4 : 2 legends, graphs compared vertically or horizontally
final_graph <- plot_grid(
graph1$net,
graph2$net,
labels = titles,
ncol = ifelse(position == "vertical", 1, 2),
nrow = ifelse(position == "vertical", 2, 1),
align = ifelse(position == "vertical", "v", "h"),
axis = "bl"
)
}
# Define classes : useful for save_graph()
class_pos <- ifelse(position == "vertical", "foodingraph_vertical",
"foodingraph_horizontal")
class(final_graph) <- c(class(final_graph), class_pos)
final_graph
}
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.