R中图形中长度为四的无弦循环数

Question

我正在尝试使用 R（igraph 包）计算无向图中长度为 4 的无弦循环的数量。
这是我的邻接矩阵（“0”和整数 > 1，因为它表示节点之间共享对象的数量）：

0   8   4   10  7   11  1   
3   1   0   0   0   0   0   
0   0   0   0   0   0   0   
0   0   0   0   0   0   0   
0   0   0   0   0   0   0   
0   0   5   0   2   0   1   
9   0   1   1   0   0   1

这是我的代码片段：

library(igraph)
A <- matrix(c(0L, 3L, 0L, 0L, 0L, 0L, 9L, 
              8L, 1L, 0L, 0L, 0L, 0L, 0L, 
              4L, 0L, 0L, 0L, 0L, 5L, 1L, 
              10L, 0L, 0L, 0L, 0L, 0L, 1L, 
              7L, 0L, 0L, 0L, 0L, 2L, 0L, 
              11L, 0L, 0L, 0L, 0L, 0L, 0L, 
              1L, 0L, 0L, 0L, 0L, 1L, 1L), 
            7, 7) 
g <- graph.adjacency(A, mode = "undirected", diag=FALSE, weighted=TRUE)

如有任何帮助，我们将不胜感激！

Answer 1

TL;DR: 答案是0，因为图形是亲切的。

图表本身如下所示：

从这张图来看，我不太乐观我们会找到长度为四的无弦循环。这可以通过这个命令快速确认：

is.chordal(g)

是returnsTRUE，表示这个图是弦图。换句话说，"each of its cycles of four or more nodes has a chord".

无论如何我都尝试枚举所有长度为 4 的无弦循环。由于我不知道有什么聪明的方法可以做到这一点，我将通过几个更简单的步骤来完成：

找到从图中的一个节点到任何其他节点的所有简单路径；
只保留长度为 4 的路径；
检查此路径的最后一个节点是否连接到起始节点，如果是，则保留此路径；
提取我保留的路径对应的所有子图；
检查它们是否是弦。

这些步骤中的每一个都可以使用 igraph 包中的函数来执行。

res <- NULL
for (vi in V(g)) {
  pi <- all_simple_paths(g, from=vi, to = V(g))
  pi_4 <- pi[sapply(pi, length)==4]
  last_v <- sapply(pi_4, "[", 4)
  pi_4_c <- pi_4[sapply(last_v, function(v) are.connected(g, 1, v))]
  subgi <- lapply(pi_4_c, function(v) induced.subgraph(g, v))
  ci <- sapply(subgi, function(g) is_chordal(g)$chordal)
  res[[vi]] <- subgi[!ci]
}
res_with_dupl <- data.frame(t(sapply(res, V)))
unique(res_with_dupl)

同样，结果是该图中没有长度为4的无弦循环（res为空）。

我真的很期待阅读其他答案！

Answer 2

这是另一种方法。虽然可能不是一种非常有效的算法方法，但它具有利用快速本机 igraph 例程的优点。基本策略是：

找出所有长度为 4
找到所有三角形
如果一个长度为 4 的循环与一个三角形共享 3 个节点，它不是无弦的，所以我们去掉它，return 剩下的。

下面是一个函数，那么我们可以在一个易于解释的人工图和一个随机图上进行测试：

library(igraph)

getChordless4s <- function(g) {
  # Add names to save on annoyance later
  if (is.null(names(V(g)))) {V(g)$name <- V(g)}
  # We get all the triangles
  tr <- triangles(g)
  tr <- matrix(names(tr), nrow=length(tr)/3, byrow = T)
  # Now we get all the cycles of length-4
  g2 <- make_ring(4)
  res <- subgraph_isomorphisms(pattern = g2, target = g)
  # strip these to the node names and drop reduncancies
  res <- unique(lapply(res, function(cyc){sort(names(cyc))}))
  # If one of our triangles appears in a length-4 cycle than 
  # that cycle is not chordless. 
  # Test for this by checking if the length of the intersection of the vertex
  # names of the 4-cycle and any triangle is 3.
  res <- res[!unlist(lapply(res, function(cyc){any(apply(tr, 1, function(row){length(intersect(cyc, row))==3}))}))]
  # Print anything we have if we have it
  if (length(res)==0) {cat("No chordless cycles of length-4 found")} else {
    res
  }
}

现在让我们生成一个玩具图，我们应该清楚预期的结果应该是什么：

g <- graph_from_data_frame(data.frame(from = c("A", "B", "C", "D", "A", "E", "E", "F"), 
                                      to = c("B", "C", "D", "A", "E", "D", "F", "D")),
                           directed = F)
plot(g)

我们显然希望函数 return A-B-C-D 而不是 A-D-E-F:

getChordless4s(g)
#> [[1]]
#> [1] "A" "B" "C" "D"

现在让我们尝试随机图：

set.seed(42)
g <- random.graph.game(10, .2)
plot(g)

# Check that there are chordless graphs to find
is.chordal(g)$chordal
#> [1] FALSE

getChordless4s(g)
#> [[1]]
#> [1] "2" "3" "7" "8"
#> 
#> [[2]]
#> [1] "2" "3" "6" "7"
#> 
#> [[3]]
#> [1] "2" "3" "5" "7"
#> 
#> [[4]]
#> [1] "3" "5" "7" "8"
#> 
#> [[5]]
#> [1] "3" "5" "6" "7"

可能已经发布了一些关于查找无弦循环的有效方法的算法，现在我很想知道它是什么。有趣的问题。

由 reprex package (v0.2.0) 创建于 2018-05-09。

R中图形中长度为四的无弦循环数

Number of chordless cycles of length four in a graph in R

r

cycle

chord