R/extract_mesolevel.R

Defines functions extract_mesolevel

Documented in extract_mesolevel

#' Extract the meso level of a multilevel network
#'
#' Extract one of the three levels of a multilevel network.
#'   \code{extract_highlevel} will extract the higher level vertices and the
#'   edges between them, \code{extract_lowlevel} will extract the lower level
#'   vertices and the edges between them. On the other hand,
#'   \code{extract_mesolevel} will extract all the vertices but only the edges
#'   between vertices from different levels.
#'
#' @author Neylson Crepalde, \email{neylsoncrepalde@@gmail.com}
#' @inheritParams set_color_multilevel
#'
#' @return \code{extract_highlevel} and \code{extract_lowlevel}
#'   return a 1-mode network. All
#'   the vertices in the selected level and the edges between them.
#'   \code{extract_mesolevel} returns a bipartite (2-mode) network.
#'   All the vertices
#'   are kept. Only edges between vertices of different levels are kept. This
#'   is what the literature also calls an \emph{affiliation} network.
#'
#' @examples
#' organizations <- extract_highlevel(linked_sim)
#'
#' individuals <- extract_lowlevel(linked_sim)
#'
#' affiliations <- extract_mesolevel(linked_sim)
#'
#' @export
extract_mesolevel <- function(x){
  if (!inherits(x, 'igraph')){
    stop("Not a graph object")
  } else {
    if (!is_multilevel(x)){
      stop("The network is not multilevel")
    } else {

      lacos = igraph::ends(x, igraph::E(x), names = FALSE)
      # buscando cada laco
      id.diff = c()
      for (i in 1:nrow(lacos)){
        # Se os nos do laco forem diferentes
        if (igraph::vertex_attr(x, "type", lacos[i,1]) !=
            igraph::vertex_attr(x, "type", lacos[i,2])){
          id.diff = c(id.diff, i)
        }
      }

      meso = igraph::subgraph.edges(x, id.diff, delete.vertices = FALSE)
      return(meso)
    }
  }
}

Try the multinets package in your browser

Any scripts or data that you put into this service are public.

multinets documentation built on Dec. 16, 2019, 1:36 a.m.