R/ectd.R

   1 #' Compute the Euclidian Commute-Time Distances (ECTD) in an undirected graph.
   2 #'
   3 #' Assuming similarity function doesn't depend on x, and undirected graph.
   4 #'
   5 #' @param o Output of \code{nng}.
   6 #' @param similarity function distance --> similarity.
   7 #' @param inf.replace Replace Inf values by large finite number ?
   8 #'
   9 #' @return A distances matrix (n x n)
  10 #'
  11 #' @export
  12 ectd <- function(o, similarity=function(x) 1, inf.replace=TRUE)
  13 {
  14   if (igraph::is_directed(o$graph))
  15     stop("Directed graph case unimplemented yet")
  16   n <- igraph::vcount(o$graph)
  17   E <- igraph::as_edgelist(o$graph, names=FALSE)
  18   W <- matrix(0, nrow=n, ncol=n)
  19   for (i in seq_len(nrow(E))) {
  20     edge <- c(E[i,1], E[i,2])
  21     W[edge[1], edge[2]] <- similarity(o$distances[i])
  22     W[edge[2], edge[1]] <- W[edge[1], edge[2]]
  23   }
  24   L <- diag(rowSums(W)) - W
  25   cc <- igraph::components(o$graph)
  26   distances <- matrix(Inf, nrow=n, ncol=n)
  27   for (i in seq_len(cc$no)) {
  28     indices <- which(cc$membership == i)
  29     L_loc <- L[indices, indices]
  30     n_loc <- cc$csize[i]
  31     if (n_loc >= 2) L_inv = pracma::pinv(L_loc)
  32     else L_inv = matrix(ifelse(L_loc != 0, 1/L_loc[1], 0))
  33     Lii = matrix(rep(diag(L_inv), each=n_loc), nrow=n_loc, byrow=TRUE)
  34     Ljj = matrix(rep(diag(L_inv), each=n_loc), nrow=n_loc)
  35     # https://math.stackexchange.com/questions/1321305/commute-time-distance-in-a-graph
  36     distances[indices, indices] <- Lii + Ljj - 2 * L_inv
  37   }
  38   if (inf.replace) {
  39     finiteMax <- max(distances[is.finite(distances)])
  40     distances[is.infinite(distances)] <- finiteMax + 1
  41   }
  42   distances
  43 }