R/compare_graphs.R

In vgasque/nutrigraph: Food Network Inference and Visualization

#' 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
}