R/InduceNetworks.R

In RandomWalkRestartMH: Random walk with restart on multiplex and heterogeneous Networks

## R Code for the Random Walk with Restart Package (RandomWalkRestartMH).

## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## 
## Functions to generate a Network with the Top results of RWR-M and
## RWR-MH results.
## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## 

## Roxy Documentation comments
#' Creates a Network with the top results of the Random Walk with restart on
#' a Multiplex Network
#'
#' \code{create.multiplexNetwork.topResults} is a function to create a network
#' from the top results of the Random Walk with Restart on Multiplex networks
#' algorithm (a \code{RWRM_Results} object).
#'
#' @usage create.multiplexNetwork.topResults(RWRM_Result_Object,
#'     MultiplexObject,k=25)
#'
#' @param RWRM_Result_Object A \code{RWRM_Results} object generated by the
#' function \code{Random.Walk.Restart.Multiplex} representing the results
#' of the Random Ralk with restart on the multiplex network described in the
#' following argument.
#' @param MultiplexObject A \code{Multiplex} object generated by the
#' function \code{create.multiplex} representing a multiplex network.
#' @param k A numeric value between 1 and 200. It is the number of top ranked
#' nodes to be included in the resulting multiplex network.
#'
#' @return An \code{igraph} object containing the top \code{k} ranked
#' multiplex nodes in the Random Walk with Restart on a Multiplex network
#' algorithm. We include all the possible types of interactions between pairs of
#' nodes according to the different layers of the multiplex network.
#'
#' @seealso \code{\link{create.multiplex}, \link{Random.Walk.Restart.Multiplex}
#' \link{isRWRM_Results}, \link{create.multiplexHetNetwork.topResults}}
#'
#' @author Alberto Valdeolivas Urbelz \email{alvaldeolivas@@gmail.com}
#'
#' @examples
#' m1 <- igraph::graph(c(1,2,1,3,2,3), directed = FALSE)
#' m2 <- igraph::graph(c(1,3,2,3,3,4,1,4), directed = FALSE)
#' multiObject <- create.multiplex(m1,m2)
#' AdjMatrix <- compute.adjacency.matrix(multiObject)
#' AdjMatrixNorm <- normalize.multiplex.adjacency(AdjMatrix)
#' Seed <- c(1)
#' RWR_MultiResults <- 
#'     Random.Walk.Restart.Multiplex(AdjMatrixNorm, multiObject, Seed)
#' create.multiplexNetwork.topResults(RWR_MultiResults,multiObject)
#'
#'@import igraph
#'@importFrom dnet dNetInduce
#'@export
create.multiplexNetwork.topResults <- 
    function(RWRM_Result_Object,MultiplexObject,k=25) {
        
    if (!isMultiplex(MultiplexObject)) {
        stop("Not a Multiplex object")
    }
        
    if (!isRWRM_Results(RWRM_Result_Object)){
        stop("Not Results of RWR-M")
    }
        
    k <- as.numeric(k)
    if (k  <= 0 || k >= 200) {
        stop("K should be between 0 and 200")
    }
        
    L <- MultiplexObject$Number_of_Layers
        
    Multiplex_df <- 
        do.call(rbind.data.frame,lapply(MultiplexObject[1:L],as_data_frame))
        
    Multiplex_Network <- graph.data.frame(Multiplex_df,directed=FALSE)
    Top_Results_Nodes <- 
        RWRM_Result_Object$RWRM_Results$NodeNames[seq_len(k)]
    Query_Nodes <- c(RWRM_Result_Object$Seed_Nodes,Top_Results_Nodes)
        
    Induced_Network <- 
        dNetInduce(g=Multiplex_Network, nodes_query=Query_Nodes, knn=0, 
            remove.loops=FALSE, largest.comp=FALSE)
    return(Induced_Network)
}


## Roxy Documentation comments
#' Creates a Network with the top results of the Random Walk with restart on
#' a Multiplex and Heterogeneous Network
#'
#' \code{create.multiplexHetNetwork.topResults} is a function to create a
#' network from the top results of the Random Walk with Restart on Multiplex and
#' Heterogeneous networks algorithm (a \code{RWRMH_Results} object).
#'
#' @usage create.multiplexHetNetwork.topResults(RWRMH_Results_Object,
#'     MultiplexHetObject, bipartite_relations, bipartite_name, k=25)
#'
#' @param RWRMH_Results_Object A \code{RWRMH_Results} object generated by the
#' function \code{Random.Walk.Restart.MultiplexHet} representing the results
#' of the Random Ralk with restart on the multiplex and heterogeneous network
#' described in the following argument.
#' @param MultiplexHetObject A \code{MultiplexHet} object generated by the
#' function \code{create.multiplexHet} representing a multiplex and
#' heterogeneous network.
#' @param bipartite_relations A data frame containing the relationships between
#' the nodes of the multiplex network and the nodes of the second network of the
#' heterogeneous system. The data frame should contain two columns: the first
#' one with the nodes of the multiplex network; the second one with the nodes of
#' the second network. Every node should be present in their corresponing
#' network.
#' @param bipartite_name A vector containing the name for the bipartite
#' relations to be integrated as part of the resulting network. It is included
#' as an attribute for all the bipartite edges of the resulting network. It's
#' optional and its default value is "bipartiteRelations".
#' @param k A numeric value between 1 and 200. It is the number of top ranked
#' nodes to be included in the resulting multiplex network.
#'
#' @return An \code{igraph} object containing the top \code{k} ranked
#' multiplex nodes and the top \code{k} ranked second network nodes in the
#' Random Walk with Restart on a Multiplex and Heterogeneous network algorithm.
#' We include all the possible types of interactions between pairs of
#' nodes according to the different layers of the multiplex network, the
#' bipartite interactions and the second network type of interactions.
#'
#' @seealso \code{\link{create.multiplexHet},
#' \link{isRWRMH_Results}, \link{Random.Walk.Restart.MultiplexHet}
#' \link{create.multiplexNetwork.topResults}}
#'
#' @author Alberto Valdeolivas Urbelz \email{alvaldeolivas@@gmail.com}
#'
#' @examples
#' m1 <- igraph::graph(c(1,2,1,3,2,3), directed = FALSE)
#' m2 <- igraph::graph(c(1,3,2,3,3,4,1,4), directed = FALSE)
#' multiObject <- create.multiplex(m1,m2)
#' h1 <- igraph::graph(c("A","C","B","E","E","D","E","C"), directed = FALSE)
#' bipartite_relations <- data.frame(m=c(1,3),h=c("A","E"))
#' multiHetObject <- 
#'     create.multiplexHet(multiObject, h1,bipartite_relations)
#' MultiHetTranMatrix <- compute.transition.matrix(multiHetObject)
#' Multiplex_Seeds <- c(1)
#' SecondNet_Seeds <- c("E")
#' RWR_MultiHetResults <- 
#'     Random.Walk.Restart.MultiplexHet(MultiHetTranMatrix, multiHetObject,
#'         Multiplex_Seeds,SecondNet_Seeds)
#' create.multiplexHetNetwork.topResults(RWR_MultiHetResults,multiHetObject,
#'     bipartite_relations)
#'
#'@import igraph
#'@importFrom dnet dNetInduce
#'@export

create.multiplexHetNetwork.topResults <- 
    function(RWRMH_Results_Object, MultiplexHetObject,bipartite_relations,
        bipartite_name, k=25) {
        
    if (!isMultiplexHet(MultiplexHetObject)) {
        stop("Not a Multiplex Heterogeneous object")
    }
        
    if (!isRWRMH_Results(RWRMH_Results_Object)){
        stop("Not Results of RWR-MH")
    }
        
    if (!is.data.frame(bipartite_relations)) {
        stop("Third element should be a data frame")
    } else {
        if (ncol(bipartite_relations) != 2) {
            stop("The data frame should contain two columns")
        } else {
            if (nrow(bipartite_relations) == 0) {
                stop("The data frame should contain any bipartite 
                    interaction")
            } else {
                names_1 <- unique(c(as.character(bipartite_relations[, 1])))
                names_2 <- unique(c(as.character(bipartite_relations[, 2])))
                if (!all(names_1 %in% MultiplexHetObject$Pool_of_Nodes)){
                    stop("Some of the nodes in the first column of the data
                        frame are not nodes of the multiplex network")
                } else {
                    if (!all(names_2 %in% 
                    V(MultiplexHetObject$Second_Network)$name)){
                        stop("Some of the nodes in the second column of the
                            data frame are not nodes of the second network")
                    }
                }
            }
        }
    }
        
    if(missing(bipartite_name)){
        bipartite_name <-c("bipartiteRelations")
    } else {
        if (!is.character(bipartite_name)) {
            stop("The name of the bipartite relations should be a vector
                of characters")}
        if (length(bipartite_name) != 1) {
            stop("The name of the bipartite relations should be a vector
                of length 1")}
    }

    k <- as.numeric(k)
    if (k  <= 0 || k >= 200) {
        stop("K should be between 0 and 200")
    }

    bipartite_relations$type <- bipartite_name
    colnames(bipartite_relations) <-c("from","to","type")

    L <- MultiplexHetObject$Number_of_Layers
    
    Multiplex_df <- 
        do.call(rbind.data.frame,lapply(MultiplexHetObject[1:L],as_data_frame))
    
    Second_Network_df <- as_data_frame(MultiplexHetObject$Second_Network)

    Multiplex_Heterogeneous_df <- 
        rbind.data.frame(Multiplex_df,Second_Network_df,bipartite_relations)

    Multiplex_Heterogeneous_Network <-
        graph.data.frame(Multiplex_Heterogeneous_df,directed=FALSE)

    Top_Results_MultiNodes <-
        RWRMH_Results_Object$RWRMH_Results_MultiplexNodes$NodeNames[seq_len(k)]
    Top_Results_SecondNetNodes <-
        RWRMH_Results_Object$RWRMH_Results_SecondNetNodes$SecondNet_node[seq_len(k)]

    Query_Nodes <- c(c(RWRMH_Results_Object$Multiplex_Seed_Nodes,
        RWRMH_Results_Object$SecondNet_Seed_Nodes), Top_Results_MultiNodes,
            Top_Results_SecondNetNodes)

    Induced_Network <- 
        dNetInduce(g=Multiplex_Heterogeneous_Network, nodes_query=Query_Nodes, 
            knn=0,remove.loops=FALSE, largest.comp=FALSE)
    return(Induced_Network)
}