Число аккордовых циклов длины четыре в графе в R - PullRequest
Новая
       39

Число аккордовых циклов длины четыре в графе в R

0 голосов
/ 09 мая 2018

Я пытаюсь подсчитать число аккордовых циклов длины четыре в неориентированном графе, используя R (igraph пакет).
Это моя матрица адъюнктивности (с «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)

Любая помощь с этим будет высоко ценится!

Ответы [ 2 ]

0 голосов
/ 09 мая 2018

Вот другой подход. Хотя, вероятно, это не очень эффективный способ сделать это алгоритмически, он имеет преимущество в том, чтобы рисовать на быстрых процедурах нативных игр. Основная стратегия:

  1. Найти все циклы длины 4

  2. Найти все треугольники

  3. Если цикл длины 4 делит 3 узла с треугольником, он не является аккордом, поэтому мы избавляемся от него и возвращаем то, что осталось.

Ниже приведена функция, затем мы можем проверить ее на простом для интерпретации искусственном графе и случайном графе: 

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)

Мы явно хотим, чтобы функция возвращала 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"

Вероятно, есть какой-то опубликованный алгоритм эффективных способов поиска аккордовых циклов, и теперь мне было бы интересно узнать, что это такое. Забавная проблема.

Создано в 2018-05-09 пакетом представ (v0.2.0).

0 голосов
/ 09 мая 2018

TL; DR : ответ 0, потому что график сердечный.

Сам график выглядит так:

Graph

Судя по графику, я не очень оптимистичен, мы найдем цикл без аккордов длиной четыре. И это может быть быстро подтверждено этой командой: 

is.chordal(g)

Возвращает TRUE, что означает, что этот граф хордовый. Другими словами, «каждый из его циклов из четырех или более узлов имеет аккорд».

Я все равно попытался перечислить все аккордовые циклы длины 4. Поскольку я не знаю какого-либо умного способа сделать это, я сделаю это с несколькими более простыми шагами:

  1. Найдите все простые пути от одного узла графа до любого другого;
  2. Хранить только пути длиной 4;
  3. Проверьте, подключен ли последний узел этого пути к начальному узлу, если он есть, то оставьте этот путь;
  4. Извлечь все подграфы, соответствующие путям, которые я сохранил;
  5. Проверьте, являются ли они хордовыми.

Каждый из этих шагов может быть выполнен с помощью функции из пакета 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 пуст).

Я действительно с нетерпением жду, чтобы прочитать другие ответы!

...