Igraph - 从每个三角形中删除最弱的边缘

Question

假设我有一个大型网络，我想根据每个三角形去除基于其重量的最弱边缘。所以如果图表

A - B，B - C，C - A，D - A 具有权重 0.5,0.3,0.2,0.1

分别删除 C - A （顶点D不是三角形的一部分）。

最有效的方法是什么？

Answer 1

让我们从一个稍微有趣的例子开始，它有两个三角形：

dat <- data.frame(V1=c("A", "B", "C", "D", "D"), V2=c("B", "C", "A", "A", "B"), wt=c(0.5, 0.3, 0.2, 0.1, 0.3), stringsAsFactors=FALSE)

为方便起见，我们将按字母顺序排列顶点

dat <- data.frame(V1=pmin(dat$V1, dat$V2), V2=pmax(dat$V1, dat$V2), wt=dat$wt)

让我们看看我们的图表：

library(igraph)
G <-graph.data.frame(dat, directed=FALSE)
plot(G, edge.label=E(G)$wt)

igraph cliques函数可以找到所有三角形（大小为3的小团体）：

(triangles <- do.call(rbind, lapply(cliques(G, min=3, max=3), function(x) sort(V(G)$name[x]))))
#      [,1] [,2] [,3]
# [1,] "A"  "B"  "C" 
# [2,] "A"  "B"  "D" 

为了识别要删除的最小权重边缘，以便我们摆脱所有三角形，我提出了一个整数规划公式，其中我们为每个边缘都有一个二进制变量，指示它是否被删除。我们对每个三角形都有一个约束，要求删除三角形中的至少一个边。目标是最小化去除边缘的权重之和。这与lpSolve包非常简单，我在下面的函数中执行此操作，它将所有步骤放在一起：

library(lpSolve)
min.cost.removal <- function(dat) {
  dat <- data.frame(V1=pmin(dat$V1, dat$V2), V2=pmax(dat$V1, dat$V2), wt=dat$wt)
  G <-graph.data.frame(dat, directed=FALSE)
  triangles <- do.call(rbind, lapply(cliques(G, min=3, max=3), function(x) sort(V(G)$name[x])))
  constr <- t(apply(triangles, 1, function(x) (dat$V1 == x[1] & dat$V2 == x[2]) +
                                              (dat$V1 == x[1] & dat$V2 == x[3]) +
                                              (dat$V1 == x[2] & dat$V2 == x[3])))
  mod <- lp(objective.in = dat$wt,
            const.mat = constr,
            const.dir = rep(">=", nrow(triangles)),
            const.rhs = rep(1, nrow(triangles)),
            all.bin = TRUE)
  dat[mod$solution >= 0.999,]
}

对于我们的图表，整数编程正确地确定了删除所有三角形的最低成本方法是删除边A-C和A-D：

min.cost.removal(dat)
#   V1 V2  wt
# 3  A  C 0.2
# 4  A  D 0.1

如果我们显着减少边缘A-B上的重量（我在这里将其减小到0.2），那么移除该边缘将成为同时移除这两个三角形的最便宜方式：

dat <- data.frame(V1=c("A", "B", "C", "D", "D"), V2=c("B", "C", "A", "A", "B"), wt=c(0.2, 0.3, 0.2, 0.1, 0.3), stringsAsFactors=FALSE)
min.cost.removal(dat)
#   V1 V2  wt
# 1  A  B 0.2