R/get_graph_object.R

#' Generate graph object from nodes and edges
#' @description Obtain a graph object in the form of an igraph with 
#' KEGG-specific graphical information
#' @param node_mapping_info The data.frame object generated by the function 
#' node_mapping_info()
#' @param expanded_edges The data.frame object generated by the function 
#' edge_mapping_info()
#' @param layered_nodes A logical indicator; if set to TRUE will create a 
#' graph with 'stacked' nodes that the user can manipulate when multiple nodes 
#' are mapped to one location
#' @return A list object with the node and edge information from the graph 
#' required for mapping.
#' @export
#' @importFrom igraph V V<-
#' @examples
#' 
#' p53_KGML <- get_KGML("hsa04115")
#' p53_KEGG_mappings <-  expand_KEGG_mappings(p53_KGML)
#' 
#' p53_node_mapping_info <- node_mapping_info(p53_KEGG_mappings)
#' p53_edge_mapping_info <- expand_KEGG_edges(p53_KGML, p53_KEGG_mappings)
#' 
#' #Default graph object will have 'expanded edges':
#' expanded_edges_graph_object <- get_graph_object(p53_node_mapping_info, 
#'                                                 p53_edge_mapping_info)
#' 
#' #Graph with layered nodes:
#' layered_nodes_graph_object <- get_graph_object(p53_node_mapping_info,
#'                                                p53_edge_mapping_info, 
#'                                                layered_nodes = TRUE)

get_graph_object <-
function(node_mapping_info, expanded_edges, layered_nodes = FALSE){
    NMI <- node_mapping_info
    if(!layered_nodes){
        edge_info <- expanded_edges
        GO <-  igraph::graph.data.frame(edge_info, directed = TRUE)
        GO <- GO + igraph::vertices(NMI$entryID[
        NMI$in_relationship == 0])
        GO <- GO + igraph::vertices(NMI$entryID[
        NMI$entryTYPE == "group"])

        V(GO)$entryNAMES <- NMI$entryNAMES[match(V(GO)$name,NMI$entryID)]
        V(GO)$entryTYPE <- NMI$entryTYPE[match(V(GO)$name,NMI$entryID)]
        V(GO)$FGcolor <- NMI$FGcolor[match(V(GO)$name,NMI$entryID)]
        V(GO)$BGcolor <- NMI$BGcolor[match(V(GO)$name,NMI$entryID)]
        V(GO)$Xcoord <- NMI$Xcoord[match(V(GO)$name,NMI$entryID)]
        V(GO)$Ycoord <- NMI$Ycoord[match(V(GO)$name,NMI$entryID)]
        V(GO)$shape <- NMI$shape[match(V(GO)$name,NMI$entryID)]
        V(GO)$width <- NMI$width[match(V(GO)$name,NMI$entryID)]
        V(GO)$height <- NMI$height[match(V(GO)$name,NMI$entryID)]
        V(GO)$entryACCNUM <- NMI$entryACCESSION[match(V(GO)$name,NMI$entryID)]
        V(GO)$LABEL <- NMI$LABEL[match(V(GO)$name,NMI$entryID)]
        V(GO)$border_width <- NMI$border_width[match(V(GO)$name,NMI$entryID)]
        V(GO)$label_font_size <- 
            NMI$label_font_size[match(V(GO)$name,NMI$entryID)]
        return(GO)
    }
    else {
        refcols <- c("entry1symbol", "entry2symbol")
        edge_info <- expanded_edges[,c(refcols, 
                                   setdiff(names(expanded_edges), refcols))]
        GO <- igraph::graph.data.frame(edge_info, directed = TRUE)
        GO <- GO + igraph::vertices(NMI$entrySYMBOL[NMI$in_relationship == 0])
        V(GO)$entryNAMES <- NMI$entryNAMES[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$entryTYPE <- NMI$entryTYPE[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$FGcolor <- NMI$FGcolor[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$BGcolor <- NMI$BGcolor[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$Xcoord <- NMI$Xcoord[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$Ycoord <- NMI$Ycoord[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$shape <- NMI$shape[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$width <- NMI$width[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$height <- NMI$height[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$entryACCNUM <- 
            NMI$entryACCESSION[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$LABEL <- NMI$entrySYMBOL[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$border_width <- 
            NMI$border_width[match(V(GO)$name,NMI$entrySYMBOL)]
        V(GO)$label_font_size <- 
            NMI$label_font_size[match(V(GO)$name,NMI$entrySYMBOL)]
    
        return(GO)
    }
}
uc-bd2k/KEGGlincs documentation built on May 3, 2019, 2:13 p.m.