R/network_compare.r

#' @title net_dissim, measuring dissimilarity of igraph networks
#'
#' The net_dissim function calculates the dissimilarity of two networks with the same number of edges given as igraph objects unsing a given metric. The distance measures used in this function are euclidian, manhattan, canberra, chi_distance, chord, bray and jaccard. It is either possible to use presence/absence of the edges or the weight of the edges for comparisson. In the case of weights euclidian or chi_distance for instance and in the case of the presence/absence jaccard or manhattan could be preferred distance measures. 
#'
#' @param ag igraph object, first graph to compare
#' @param bg igraph object, second graph to compare, same number of edges as ag
#' @param method character string, distance measure, metric
#' @param type character string, indicating whether to use the edges (0,1) or the weights
#' @param weight character string, indicating the column used as weight, if a different column than "weights" is used (not implemented yet)
#'
#' @return
#' @export
#' 
#' @author Oliver Nakoinz <oliver.nakoinz@ufg.uni-kiel.de>
#'
#' @examples
#' bm <- matrix(c(1,0,1,0,1,1,0,1,1),nrow=3)
#' bg <- graph_from_adjacency_matrix(bm , mode = "directed", weighted = TRUE, diag = TRUE)
#' am <- matrix(c(1,1,0,1,1,0,0,0,1),nrow=3)
#' ag <- graph_from_adjacency_matrix(am , mode = "directed", weighted = TRUE, diag = TRUE)
#' net_dissim(ag, bg, "jaccard", type = "edges")
#' am <- matrix(c(1,2,3,2,5,6,3,6,9),nrow=3)
#' bg <- graph_from_adjacency_matrix(am , mode = "directed", weighted = TRUE, diag = TRUE)
#' E(bg)$weight <- c(1,2,3,2,5,6,3,6,9)
#' bm <- matrix(c(1,2,4,2,3,5,4,5,9),nrow=3)
#' ag <- graph_from_adjacency_matrix(bm , mode = "directed", weighted = TRUE, diag = TRUE)
#' E(ag)$weight <- c(1,2,4,2,3,5,4,5,9)
#' net_dissim(ag, bg, "chi_distance", type = "weights")
#' 
net_dissim <- function(ag, bg, method = "chi_distance", type = "edges", weight = "weights"){
    if(type == "edges"){
        a <- as_adj(ag, type = "both", names = TRUE, sparse = FALSE)
        b <- as_adj(bg, type = "both", names = TRUE, sparse = FALSE)
        dim(a) <- NULL
        dim(b) <- NULL
    }
    if(type == "weights"){
        a <- E(ag)$weight
        b <- E(bg)$weight
        #eval(parse(text=paste0("a <- E(ag)$weight",weight)))
        #eval(parse(text=paste0("b <- E(bg)$weight",weight)))
    }
    
    if (method == "euclidean"){
        m_distance <- sqrt(sum((a-b)^2))
    }
    if (method == "manhattan"){
        m_distance <- sum(abs(a-b))
    }
    if (method == "canberra"){
        m_distance <- sum(abs(a-b)/(abs(a) + abs(b)))
    }
    if (method == "chi_distance"){
        m_distance <- sum(((a-b)^2)/(a+b))
    }
    if (method == "chord"){
        m_distance <- sqrt(sum((sqrt(a) - sqrt(b))^2))
    }
    if (method == "bray"){
        m_distance <- sum(abs(a - b)) / sum(a + b)
    }
    if (method == "jaccard"){
        mi <- sum((a==b)&a==1)
        mv <- sum(a)+sum(b)-mi
        m_distance <- 1-mi/mv
    }
    return(m_distance)
}


#' @title net_dist_mat, dissimilarity matrix of igraph networks
#' 
#' The function net_dist_mat calculates a dissimilarity matrix for a list of igraph objects using net_dissim() for pairwise calculation.
#'
#' @param x list of igraph objects of the same structure (same edges and nodes for weight comparison and same nodes for edge comparison)
#' @param method character string, distance measure, metric
#' @param type character string, indicating whether to use the edges (0,1) or the weights
#' @param weight character string, indicating the column used as weight, if a different column than "weights" is used (not implemented yet)
#'
#' @return
#' @export
#' 
#'@author Oliver Nakoinz <oliver.nakoinz@ufg.uni-kiel.de>
#'
#' @examples
#' v1 <- c(1,0,1,0,1,0,1,0,1)
#' v2 <- c(1,2,3,2,5,6,3,6,9)
#' v2 <- c(1,1,1,1,1,0,1,0,1)
#' v3 <- c(1,0,1,0,1,1,1,1,1)
#' v4 <- c(1,1,1,1,1,0,1,0,1)
#' m1 <- matrix(v1,nrow=3)
#' m2 <- matrix(v2,nrow=3)
#' m3 <- matrix(v3,nrow=3)
#' m4 <- matrix(v4,nrow=3)
#' n1 <- graph_from_adjacency_matrix(m1 , mode = "directed",  diag = TRUE)
#' n2 <- graph_from_adjacency_matrix(m2 , mode = "directed",  diag = TRUE)
#' n3 <- graph_from_adjacency_matrix(m3, mode = "directed",  diag = TRUE)
#' n4 <- graph_from_adjacency_matrix(m4 , mode = "directed",  diag = TRUE)
#' net_list <- list(net1 = n1, net2 = n2, net3 = n3, net4 = n4)
#' net_mat <- net_dist_mat(x = net_list, method = "jaccard", type = "edges")
#' library(pheatmap)
#' pheatmap(net_mat)
#' 
#' v1 <- c(1,2,4,2,3,5,4,5,9)
#' v2 <- c(1,2,3,2,5,6,3,6,9)
#' v3 <- c(8,6,3,6,4,7,3,7,5)
#' v4 <- c(2,1,3,1,5,6,3,6,9)
#' m1 <- matrix(v1,nrow=3)
#' m2 <- matrix(v2,nrow=3)
#' m3 <- matrix(v3,nrow=3)
#' m4 <- matrix(v4,nrow=3)
#' n1 <- graph_from_adjacency_matrix(m1 , mode = "directed", weighted = TRUE, diag = TRUE)
#' E(n1)$weight <- m1
#' n2 <- graph_from_adjacency_matrix(m2 , mode = "directed", weighted = TRUE, diag = TRUE)
#' E(n2)$weight <- m2
#' n3 <- graph_from_adjacency_matrix(m3, mode = "directed", weighted = TRUE, diag = TRUE)
#' E(n3)$weight <- m3
#' n4 <- graph_from_adjacency_matrix(m4 , mode = "directed", weighted = TRUE, diag = TRUE)
#' E(n4)$weight <- m4
#' net_list <- list(n1,n2,n3,n4)
#' net_dist_mat(x = net_list, method = "euclidean", type = "weights")
#' 
net_dist_mat <- function(x, method = "jaccard", type = "edges", weight = "weights"){
    n = length(x)
    dist_mat <- matrix(1:(n*n), nrow = n)
    for (i in 1:n){
        n1 <- x[[i]]
        for (j in i:n){ 
            n2 <- x[[j]]
            d12 <- net_dissim(n1,n2, method = method, type = type, weight = weight)
            dist_mat[i,j] <- d12
            dist_mat[j,i] <- d12
        }
    }
    if (is.null(names(x)) == FALSE) {
        nam <- names(x)
        rownames(dist_mat) <- nam
        colnames(dist_mat) <- nam
    }

    return(dist_mat)
}
CRC1266-A2/moin documentation built on May 7, 2019, 8:56 p.m.