R/plot_modular_matrix.R

In Ecological-Complexity-Lab/infomap_ecology_package: Community Detection using Infomap, Inspired by Ecological Networks

#' Plot a matrix with colored interactions by modules
#'
#' @param x An object of class \code{infomap_monolayer}.
#' @param fix_coordinates Should x and y coordinates be fixed by ggplot to
#'   create square cells.
#' @param transpose Option to transpose the matrix. Useful for matrices with
#'   very differnt numbers of rows and columns.
#' @param outside_module_col Color of interactions outside modules.
#' @param axes_titles Titles for axes
#'
#' @details Use ggplot to plot a matrix in which cells (network interactions)
#'   are colored. Interactions that fall outside the modules are colored in
#'   \code{outside_module_col} and those that fall inside the module are colored
#'   by colors automatically generated by \code{gg_color_hue} from package metafolio.
#'   
#' @examples
#' \dontrun{
#' network_object <- create_monolayer_network(bipartite::memmott1999,
#'  bipartite = TRUE, directed = FALSE, group_names = c('A','P'))
#'  
#' infomap_object <- run_infomap_monolayer(network_object, infomap_executable='Infomap',
#'                                        flow_model = 'undirected',
#'                                        silent=TRUE, trials=20, two_level=TRUE, seed=123)
#' plot_modular_matrix(infomap_object, fix_coordinates = TRUE)
#'  }
#'  
#' @return An object of class \code{ggplot}.
#'
#' @seealso \code{ggplot2, infomap_monolayer}
#'
#' @export
## @import dplyr
## @import magrittr
## @import ggplot2
plot_modular_matrix <- function(x, fix_coordinates=T, axes_titles=c('Set 1', 'Set 2'), transpose=F, outside_module_col='gray'){

  if(class(x)!='infomap_monolayer'){stop('x must be of class infomap_monolayer')}
  
  # Add module affiliations to the edge list, module 1 is the affiliation of the node from Set1; module2 is the affiliation of the node from Set2
  M_set1 <- M_set2 <- x$edge_list[1:3]
  names(M_set1) <- names(M_set2) <- names(x$edge_list)[1:3] <- c('Set1','Set2','w')
  suppressMessages(suppressWarnings(M_set1 %<>% left_join(x$modules, by=c('Set1'='node_name')) %>% rename(module1=module_level1)))
  suppressMessages(suppressWarnings(M_set2 %<>% left_join(x$modules, by=c('Set2'='node_name')) %>% rename(module2=module_level1)))
  # Join into a single tibble
  suppressMessages(suppressWarnings(
    M <- full_join(M_set1, M_set2, by = c("Set1", "Set2", "w")) %>% 
      dplyr::select(Set1, Set2, w, module1, module2)
  ))
  # Order by modules
  Set1_modules <- unique(M_set1[,c('Set1','module1')])
  Set1_modules <- with(Set1_modules, Set1_modules[order(module1,Set1),])
  Set2_modules <- unique(M_set2[,c('Set2','module2')])
  Set2_modules <- with(Set2_modules, Set2_modules[order(module2,Set2),])
  
  M %<>% 
    mutate(edge_in_out=ifelse(module1==module2,'in','out')) %>% # Determine if an interaction falls inside or outside a module
    mutate(value_mod=ifelse(edge_in_out=='in',module1,0)) %>% # Assign a module value of 0 if interaction falls outside the modules
    mutate(Set1=factor(Set1, levels=Set1_modules$Set1), Set2=factor(Set2, levels=Set2_modules$Set2))
  # Define module colors
  module_colors <- tibble(module1=unique(M$module1), col=gg_color_hue(n=length(unique(M$module1))))
  # Join the module colors to the edge list
  # If there are no interactions outside the module then do not need the gray
  # color. Otherwise, it will plot the first module in gray.
  
  suppressMessages(M %<>% left_join(module_colors) %>%
                     mutate(col=ifelse(edge_in_out=='in',col,outside_module_col)))
  
  # Generate a plot of a modular matrix
  if (transpose){
    p <- ggplot()+
      geom_tile(data=M %>% filter(w!=0), aes(Set2, Set1, fill=col)) # Interactions within modules
  } else {
    p <- ggplot()+
      geom_tile(data=M %>% filter(w!=0), aes(Set1, Set2, fill=col)) # Interactions within modules
    # geom_tile(data=M %>% filter(w==0), aes(Set1, Set2), fill='white') + # Add nodes with no interactions, if they exist
  }
  p <- p +
    labs(x=axes_titles[2], y=axes_titles[1]) +
    scale_fill_identity()+
    theme(legend.position='none',
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.background = element_blank(),
          axis.text.x = element_text(angle = 90),
          # axis.text.y = element_blank(),
          axis.ticks = element_blank())
  if (fix_coordinates){
    p <- p+coord_fixed()
  }
  return(p)
}