A utility function for stapling together igraph graphs

mergeGraphs.R

pacman::p_load(igraph,data.table,magrittr)


mergeGraphs <- function(...,desiredEdgeAttributes = c("from","to","edge_type"), omitNAnodes = TRUE){

  graphList <- list(...)
  
  tryCatch({
    
    if(graphList %>% sapply(is.igraph) %>% all){

    }else{
      stop("Input should be series of igraph objects or a single list of such objects")
    }
  },error = function(e){
    
    graphList <<- c(...)
    
    if(graphList %>% sapply(is.igraph) %>% all){

    }else{
      stop("Input should be series of igraph objects or a single list of such objects")
    }
  })
  
  mergedGrapsEdgeDT <- graphList %>%
    lapply(get.data.frame) %>%
    lapply(data.table) %>%
    lapply(function(dt) { dt[,desiredEdgeAttributes, with = F]}) %>%
    rbindlist %>% 
    .[(!is.na(from) | !is.na(to)) &  omitNAnodes] %>% 
    .[,.(edgeCount = .N),by=desiredEdgeAttributes]
  
  mergedGraph <- mergedGrapsEdgeDT %>% graph.data.frame
  
  commonNodeIDs <- graphList %>%
    lapply(get.data.frame,what="vertices") %>%
    lapply(colnames) %>%
    lapply(as.vector) %>% 
    Reduce(intersect,.)
  
  if(! "name" %in% commonNodeIDs){
    warning("Not all graphs have a 'name' attribute, which is odd ...")
    
  }else{
    
    mergedGrapsNodeDT <- graphList %>%
      lapply(get.data.frame,what="vertices") %>%
      lapply(data.table) %>% 
      lapply(function(dt) { dt[,commonNodeIDs, with = F]}) %>%
      rbindlist %>%
      .[,.(nodeCount = .N),by=commonNodeIDs]
    
    setkey(mergedGrapsNodeDT,name)
    
    for(nodeLabel in c(setdiff(commonNodeIDs,"name"),"nodeCount")){
      mergedGraph <- set_vertex_attr(mergedGraph,
                                     nodeLabel,
                                     value = mergedGrapsNodeDT[V(mergedGraph)$name,get(nodeLabel)])
    }
  }
  
  return(mergedGraph)
}