Igraph - 從每個三角形中刪除最薄弱的邊緣

Question

假設我有一個大型網絡，並且我想根據其重量去除每個三角形最薄弱的邊緣。因此，如果圖形

A - B，B - C，C - A，d - 甲具有權重 0.5，0.3，0.2，0.1

分別除去Ç - 甲（頂點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,] 
} 

對於我們的圖形，整數規劃正確識別成本最低的方法來去除所有的三角形被去除邊緣AC和AD：

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

如果我們顯著減少對邊緣AB的重量（我把它降低到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