R/InduceNetworks.R

In alberto-valdeolivas/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(list(m1=m1,m2=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 (bipartite
#' interactions) between the nodes of the first multiplex network and the nodes 
#' of the second multiplex of the heterogeneous system. The data frame should 
#' contain two or three columns: the first one with the nodes of the multiplex 
#' network; the second one with the nodes of the second network. 
#' The third one is not mandatory and it should contain the weights. Every node 
#' should be present in their corresponding multiplex 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_1 <- create.multiplex(list(m1=m1,m2=m2))
#' h1 <- igraph::graph(c("A","C","B","E","E","D","E","C"), directed = FALSE)
#' multiObject_2 <- create.multiplex(list(h1=h1))
#' bipartite_relations <- data.frame(m=c(1,3),h=c("A","E"))
#' multiHetObject <- 
#'     create.multiplexHet(multiObject_1, multiObject_2,bipartite_relations)
#' MultiHetTranMatrix <- compute.transition.matrix(multiHetObject)
#' Multiplex1_Seeds <- c(1)
#' Multiplex2_Seeds <- c("E")
#' RWR_MultiHetResults <- 
#'     Random.Walk.Restart.MultiplexHet(MultiHetTranMatrix, multiHetObject,
#'         Multiplex1_Seeds,Multiplex2_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) %in% c(2,3))) { 
        stop("The data frame should contain two or three 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$Multiplex1$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% 
                     MultiplexHetObject$Multiplex2$Pool_of_Nodes)){
              stop("Some of the nodes in the second column of the
                   data frame are not nodes of the second network")
            }
            }
          }
        }
    }

    if (ncol(bipartite_relations) == 3){
      b <- 1
      weigths_bipartite <- as.numeric(bipartite_relations[, 3])
      if (min(weigths_bipartite) != max(weigths_bipartite)){
        a <- min(weigths_bipartite)/max(weigths_bipartite)
        range01 <- 
          (b-a)*(weigths_bipartite-min(weigths_bipartite))/
          (max(weigths_bipartite)-min(weigths_bipartite)) + a
        bipartite_relations[, 3] <- range01
      } else {
        bipartite_relations[, 3] <- rep(1, length(bipartite_relations[, 3]))
      }
    } else {
      bipartite_relations$weight <- rep(1, nrow(bipartite_relations))
    }   
    
    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", "weight", "type")

    Number_Layers_1 <- MultiplexHetObject$Multiplex1$Number_of_Layers 
    Number_Layers_2 <- MultiplexHetObject$Multiplex2$Number_of_Layers 
    
    Multiplex1_df <- 
      do.call(rbind.data.frame,
              lapply(MultiplexHetObject$Multiplex1[1:Number_Layers_1],as_data_frame))
    
    Multiplex2_df <- 
      do.call(rbind.data.frame,
              lapply(MultiplexHetObject$Multiplex2[1:Number_Layers_2],as_data_frame))
    
    Multiplex_Heterogeneous_df <- 
      rbind.data.frame(Multiplex1_df,Multiplex2_df,bipartite_relations)
    
    Multiplex_Heterogeneous_Network <-
      graph.data.frame(Multiplex_Heterogeneous_df,directed=FALSE)
    
    Top_Results_MultiNodes <-
      RWRMH_Results_Object$RWRMH_Multiplex1$NodeNames[seq_len(k)]
    Top_Results_SecondNetNodes <-
      RWRMH_Results_Object$RWRMH_Multiplex2$NodeNames[seq_len(k)]
    
    Query_Nodes <- c(RWRMH_Results_Object$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)
    }