图节点之间的乘性距离

Question

我希望能够找到图中所有节点之间的距离，但是不是将边权重相加，而是将它们相乘。

举个例子:

library(igraph)

# create a weighted adjacency matrix
mx <- structure(c(0, 0.5, 0, 0, 0, 0.5, 0, 0.5, 0.5, 0, 0, 0.5, 0, 0, 0.5, 0, 0.5, 
    0, 0, 0, 0, 0, 0.5, 0, 0), .Dim = c(5L, 5L))

## convert to igraph object
mx2 <- graph.adjacency(mx, weighted = TRUE)

我可以按照以下方式获取所有节点之间的距离：

我可以按照以下方式获取所有节点之间的距离：

shortest.paths(mx2)

 [,1] [,2] [,3] [,4] [,5]
[1,]  0.0  0.5  1.0  1.0  1.5
[2,]  0.5  0.0  0.5  0.5  1.0
[3,]  1.0  0.5  0.0  1.0  0.5
[4,]  1.0  0.5  1.0  0.0  1.5
[5,]  1.5  1.0  0.5  1.5  0.0

但是，这个计算距离的方法是通过将相关权重相加来计算所有节点之间的距离。我想要将它们相乘，结果如下:

      [,1] [,2] [,3]  [,4]  [,5]
[1,] 0.000 0.50 0.25 0.250 0.125
[2,] 0.500 0.00 0.50 0.500 0.250
[3,] 0.250 0.50 0.00 0.250 0.500
[4,] 0.250 0.50 0.25 0.000 0.125
[5,] 0.125 0.25 0.50 0.125 0.000

据我所知，在igraph的“开箱即用”选项中无法完成此操作，我正在努力自己解决问题（在实际数据中，矩阵要大得多，并且有各种不同的大小）。如有建议，请不吝赐教。

- flee

Answer 1

写一个像上面答案中的函数肯定是更好的方法。但是另一种思考问题的方法是，如果你想要权重的乘积，而 shortest.paths() 给出的是权重之和，那么如果你将权重的对数输入 shortest.paths() 函数，结果的指数将等于权重的乘积。

实际上，这比我想象的要棘手一些，因为你的权重在 0 和 1 之间，shortest.paths() 算法不会接受负权重，但是你可以通过在计算权重之前和之后乘以 -1 来解决这个问题。

library(igraph)

## Cheat and log it
ln.mx <- structure(c(0, 0.5, 0, 0, 0, 0.5, 0, 0.5, 0.5, 0, 0, 0.5, 0, 0, 0.5, 0, 0.5, 
                  0, 0, 0, 0, 0, 0.5, 0, 0), .Dim = c(5L, 5L))
ln.mx <- ifelse(ln.mx!=0, log(ln.mx), 0) 

## convert to igraph object
ln.mx2 <- graph.adjacency(ln.mx, weighted = TRUE)

# The issue with the approach is that the shortest.path algorithm doesn't like
# negative weights. Since your weights fall in (0,1) their log is negative.
# We multiply edge weights by -1 to swap the sign, and then will 
# multiply again by -1 to get
# the result
E(ln.mx2)$weight <- -1*E(ln.mx2)$weight

# The result is just the regular shortest paths algorithm,
# times -1 (to undo the step above) and exponentiated to undue the logging
res <- exp(shortest.paths(ln.mx2)* -1)

# its still not perfect since the diagonal distance defaults to
# zero and exp(0) is 1, not 0. So we manually reset the diagonal
diag(res) <- 0

# The result is as hoped
res
#>       [,1] [,2] [,3]  [,4]  [,5]
#> [1,] 0.000 0.50 0.25 0.250 0.125
#> [2,] 0.500 0.00 0.50 0.500 0.250
#> [3,] 0.250 0.50 0.00 0.250 0.500
#> [4,] 0.250 0.50 0.25 0.000 0.125
#> [5,] 0.125 0.25 0.50 0.125 0.000

- gfgm

---

好的，谢谢你提供这个。我可能会使用DJack的解决方案，但这对其他情况也非常有帮助。 - flee

我一直在尝试使用你的解决方案，并遇到了一个问题，当我的矩阵包含0、介于0和1之间的值以及1时，它无法正常工作，因为log(1) == 0，我认为这应该很容易解决，但我还是有些困难，你能看出一个简单的解决方案吗？谢谢。 - flee

嗨@flee，如果您查看我上面回答中的玩具代码，您会发现它实际上与您描述的情况相同：有一堆零权重。我通过仅记录非零值来解决这个问题--即上面的那行代码ifelse(ln.mx!=0, log(ln.mx), 0)。由于权重为0的链接对距离没有任何贡献，因此它们被略微不一致地处理并不重要--它们不会影响结果，因为它们的权重为零。 - gfgm

嗨@gfgm，感谢您的快速回应！也许我误解了，但我认为问题仍存在。请尝试在您的示例代码中将0.5替换为1，并重新运行代码，结果并不是乘法路径权重（因为1被记录下来而需要保持为1）。例如，如果一个路径具有权重值（0.5，0.5，1），则结果应该为0.5 x 0.5 x 1 = 0.25，但这不是产生的结果。 - flee

抱歉，@flee周末不在。我认为记录1应该可以正常工作。考虑0.5 x 0.5 x 1 = ln（0.5）+ ln（0.5）+ ln（1）= ln（0.5）+ ln（0.5）+ 0 = 0.5 x 0.5 = 0.5 x 0.5 x 1。我认为问题在于上面的玩具示例中，我先记录了权重，然后创建了图形对象，结果图形被毁坏了。尝试先创建图形，然后将权重设置为E(ln.mx2)$weight <- -1 * (ifelse(E(ln.mx2)$weight != 0, log(E(ln.mx2)$weight), 0)。 - gfgm

完全不用担心！那个很完美，我之前花了很长时间调整顺序都没成功。非常感谢！ - flee

Answer 2

这里有一个提案。也许还有很大的改进空间，但它可以得到期望的输出。想法是提取每对节点的最短路径，然后将与每个路径相关联的权重相乘（我使用了这个答案中的一些代码）。

shortest.paths.multi <- function(mx) {
  output <- mx
  mx2 <- graph.adjacency(mx, weighted = TRUE)
  for (r in 1:nrow(mx)){
    for (c in 1:nrow(mx)){
      SP <- shortest_paths(mx2, from = r, to = c)
      VP <- SP$vpath[[1]]
      EP <- rep(VP, each=2)[-1]
      EP <- EP[-length(EP)]
      output[r, c] <- prod(E(mx2)$weight[get.edge.ids(mx2, EP)])
    }
  }
  diag(output) <- 0
  output
}

shortest.paths.multi(mx)

      [,1] [,2] [,3]  [,4]  [,5]
[1,] 0.000 0.50 0.25 0.250 0.125
[2,] 0.500 0.00 0.50 0.500 0.250
[3,] 0.250 0.50 0.00 0.250 0.500
[4,] 0.250 0.50 0.25 0.000 0.125
[5,] 0.125 0.25 0.50 0.125 0.000

编辑

这里可能有一种更好的编写该函数的方式：

shortest.paths.multi <- function(r, c){ 
  SP <- shortest_paths(mx2, from = r, to = c)
  VP <- SP$vpath[[1]]
  EP <- rep(VP, each=2)[-1]
  EP <- EP[-length(EP)]
  prod(E(mx2)$weight[get.edge.ids(mx2, EP)])
}

VecFun <- Vectorize(shortest.paths.multi)

output <- outer(1:nrow(mx), 1:ncol(mx), FUN = VecFun)
diag(output) <- 0
output

- DJack