Найти все циклы в неориентированном графе по матрице смежности

[kappa937]

Сообщение от Sibedir

Пройтись по всем не "Исследованным" ячейкам и найти для них все пути обратно (из ячейки U в U если путь длиннее чем 2) помечая их после как "Исследованные".

Спасибо за решение, но не совсем понял вот это. Это для определения длин? Что вы имеет ввиду под исследованными и неисследованными ячейками?

[Sibedir]

Не. М-м-м. Как бы объяснить мысль?

Допустим
G - это исходный граф
v - некая его вершина

Имеется некоторая операция вырезки вершины:
G' = (G - v)
, где G' - это такой же граф, но уже без вершины v и всех прилегающих к ней рёбер

Имеется функция Count(G) - количество искомых циклов в графе G

Имеется функция Circle(G,v) - количество циклов, в которые входит вершина v (если мы вышли из вершины v по одному из рёбер, то функция показывает сколькими путями можно вернуться обратонго в вершину v по другому ребру)

Ключевая мысль такая:
Count(G) = Circle(G,v) + Count(G')
, где G' = (G - v)

А пометить вершину, как исследованную - имелось в виду, что можно считать её как отсутствующую, ну или просто удалить её из графа.

Вот собственно беда именно с Circle(G,v). Пытаюсь стягивать граф. Но путают взаимопересечения циклов (наложения и восьмерки).

// ----------------------------------------
Вообще перед работой с графом можно его как следует потрясти

procedure DelVertex (aGraph : PGraph; aVertex: Integer);
var
  i, j, c: Integer;
begin
  for i := 0 to _HIGH do begin
    aGraph[aVertex,i] := 0;
    aGraph[i,aVertex] := 0;
  end;
end;

function EdgeCount (aGraph : PGraph; aEdge: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to _HIGH do
    Result := Result + Graph [aEdge, i];
end;

function Shear (aGraph: PGraph): Integer;
var
  i, j, c: Integer;
begin
  for i := 0 to _HIGH do
    if EdgeCount (aGraph, i) < 2 then
      DelVertex (aGraph, i);
end;

procedure Shave (aGraph: PGraph);
begin
  while Shear(aGraph) > 0 do
end;

[Sibedir]

Довольно жирно (полный перебор), но лучше навряд ли сделаю.

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  _COUNT = 16;
  _HIGH  = _COUNT - 1;

type
  TFlags  = array [0.._HIGH] of Boolean;
  TBoofer = array [0.._HIGH] of Integer;
  TGraph  = array [0.._HIGH, 0.._HIGH] of Boolean;

var
  Graph : TGraph ;
  Flags : TFlags ;
  Boofer: TBoofer; // Буфер для хранения пути
  Step: Integer; // Индекс текущего шага (для буфера)

// Создаёт ребра
procedure SetEdge (aVertex1, aVertex2: Integer);
begin
  Graph [aVertex1, aVertex2] := True;
  Graph [aVertex2, aVertex1] := True;
end;

// Удаляет вершину
procedure DelVertex (aVertex: Integer);
var
  i: Integer;
begin
  for i := 0 to _HIGH do begin
    Graph[aVertex,i] := False;
    Graph[i,aVertex] := False;
  end;
end;

// Количество рёбер у вершины
function EdgeCount (aEdge: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to _HIGH do
    if Graph [aEdge, i] then Inc (Result);
end;

// Обрезает все вершины с одним ребром
function Shear: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to _HIGH do begin
    if EdgeCount (i) = 1 then begin
      DelVertex (i);
      Inc (Result);
    end;
  end;
end;

// Обрезает все тупеки
procedure Shave;
begin
  while Shear > 0 do
end;

// Печатает путь-цикл из буфера
procedure PrintWay;
var
  i: Integer;
begin
  for i := 0 to Step do
    Write (Boofer[i], ' -> ');
  Writeln (Boofer[0]);
end;

// Печатает граф
procedure PrintGraph;
var
  i, j: Integer;
begin
  Writeln;
  Writeln ('-------------------------------------------------------------');
  Write('   ');
  for j := 0 to _HIGH do Write(j:4);
  Writeln;
  for i := 0 to _HIGH do begin
    Write (i:3);
    for j := 0 to _HIGH do
      if Graph[i,j] then
        Write ('  * ')
      else
        Write ('  - ');
    Writeln;
  end;
  Writeln ('-------------------------------------------------------------');
  Readln;
end;

// Кол-во путей из aFrom в aTo
function FindWay (aFrom, aTo: Integer): Integer;
var
  i: Integer;
  b: Boolean;
begin
  Result := 0;
  if (aFrom < 0) or (aTo < 0) then Exit;

  Flags[aFrom] := True;  // ставим метку
  Inc(Step);             // прибавляем шаг
  Boofer[Step] := aFrom; // запаминаем текущих шаг в буфер

  for i := 0 to _HIGH do begin
    if Graph[aFrom,i] then begin // перебираем все смежные ячейки
      if i = aTo then begin // если мы пришли в исходную ячейку
        Inc(Result); // увеличиваем результат
        PrintWay; // печатаем путь
      end else begin
        if Flags[i] then Continue; // удав не кусает сам себя
        b := Graph[i,aFrom];
        Graph[i,aFrom] := False; // запираем обратный путь
        Result := Result + FindWay (i, aTo);
        Graph[i,aFrom] := b; // отпираем обратный путь
      end;
    end;
  end;

  Flags[aFrom] := False; // снимаем метку
  Dec(Step);
end;

function MAIN: Integer;
var
  i: Integer;
begin
  Result := 0;

  Shave;
  PrintGraph;

  for i := 0 to _HIGH do Flags[i] := False;

  for i := 0 to _HIGH-2 do begin
    if EdgeCount(i) > 0 then begin
      Step := -1;
      Result := Result + FindWay(i, i);
      DelVertex(i); // после каждой итерации отсекаем вершину (см. пост #12)
      Shave;
    end;
  end;
end;

// -----------------------------------------------------------------------------
var
  i, j: Integer;
begin
  // Обнуляем
  for i := 0 to _HIGH do
    for j := 0 to _HIGH do
      Graph[i,j] := False;

  // Заполняем
  SetEdge ( 0,  1); //  1
  SetEdge ( 0,  2); //  2
  SetEdge ( 0,  3); //  3
  SetEdge ( 3,  4); //  4
  SetEdge ( 3,  5); //  5
  SetEdge ( 4,  6); //  6
  SetEdge ( 4,  8); //  7
  SetEdge ( 5,  6); //  8
  SetEdge ( 5, 14); //  9
  SetEdge ( 5, 15); // 10
  SetEdge ( 6, 10); // 11
  SetEdge ( 7,  9); // 12
  SetEdge (10, 12); // 13
  SetEdge (11, 12); // 14
  SetEdge (12, 13); // 15
  SetEdge (13, 14); // 16

  SetEdge ( 1, 7);
  SetEdge ( 7, 8);

//  Graph[4,3] := False;

  PrintGraph;

  // Выводим
  Writeln (MAIN);
  Readln;
end.

kappa937, проверь, еслифчё. Он правда все циклы по 2 раза берет (туда и обратно). Но на это уже нет желания. Хотя оно и не надо. Poma][a правильно сказал:

Сообщение от Poma][a

Граф неориентированный

И хотя "1-2-1" мы за цикл здесь не считаем, "туда-сюда" ("1-2-3-1" и "1-3-2-1") пусть будут разные циклы. Ибо тогда, если убрать вызов Shave, то алгоритм будет работать и для ориентированного графа.

P.S.: kappa937, если узнаешь правильное, ну или более изящное решение, выложи здесь.

[Poma][a]

#include <iostream>
#include <vector>
#include <queue>
#include <algorithm>

#define INF 100000

using namespace std;

int cnt4 = 0, cnt6 = 0, cnt8 = 0;

vector<vector<int>> v;

void dfs(vector<bool> use, int k, int anc, int wave = 0)
{
	if (v[k][anc] != 0 && wave == 3)
		cnt4++;
	if (v[k][anc] != 0 && wave == 5)
		cnt6++;
	if (v[k][anc] != 0 && wave == 7)
		cnt8++;
	if (wave > 9) return;
	use[k] = true;
	for (int i = 0; i < v.size(); i++)
	{
		if (!use[i] && v[k][i] != 0)
		{
			use[i] = true;
			dfs(use, i, anc, wave+1);
			use[i] = false;
		}
	}
}

int main()
{
	int n;
	cin >> n;

	v.assign(n, vector<int>(n));

	/*for (int i = 0; i < n; i++)
	for (int j = 0; j < n; j++)
	cin >> v[i][j];
	*/

	int m;
	cin >> m;
	for (int i = 0; i < m; i++)
	{
		int a, b;
		cin >> a >> b;
		a--; b--;
		v[a][b] = 1;
		v[b][a] = 1;
	}

	for (int i = 0; i < n; i++)
	{
		vector<bool> use(n, false);
		use[i] = true;
		dfs(use, i, i);
	}

	cout << "4 :" << (cnt4)/4/2 << endl;
	cout << "6 :" << (cnt6)/6/2 << endl;
	cout << "8 :" << (cnt8)/8/2 << endl;

	return 0;
}

Вариант от меня

[Sibedir]

Poma][a, поясни пожалуйста.
Почему именно 4, 6 и 8? Получается, что это просто частный случай для графа из поста #5 (просто идея)? Или как?

[Poma][a]

Потому что мы ищем циклы с весом 4, 6, 8.
А идея..
Все портит неориентированность.. У меня был вариант с dfs'ом с одним глобальным массивом (кстати мой use можно тоже сделать глобальным).. Но тот массив просто отмечал один раз и больше не трогался, но там был wave. Тогда я решил переписать это чудо в bfs.
Но везде был косяк..
Есть вершина входит в два и более циклов, то некоторые из них не будут учитываться.. Именно поэтому нам и нужен use. (Поясню :
Пусть есть граф из 6 вершин. В нем 7 ребер :

1 2
2 3
3 4
4 1
4 5
5 6
6 1

Вот.. Давайте скажем, что путем из вершины A в вершину B является набор вершин W(A-Vi-Vj-..-Vk-B). Дак вот, пусть путь из 1 в 4 равен W(1-4). Теперь из вершины 4 можно сходить в вершину 1. Тогда мы должны запомнить, что мы использовали путь W(1-2-3-4)+W(4-1) = W(1-2-3-4-1). И больше его никогда не трогать.)

Вот.. Именно поэтому пришлось крутить dfs для всех вершин..
Еще могут быть не очень понятны строки :

cout << "4 :" << (cnt4)/4/2 << endl;
cout << "6 :" << (cnt6)/6/2 << endl;
сout << "8 :" << (cnt8)/8/2 << endl;

Я запускаю dfs от всех вершин. Поэтому вместо одного цикла с весом M, он насчитает 2*M циклов. M-потому что dfs бахаем ото всех. А двойка - потому что у нас два направления движения. W(1-2-3-4-1) равен W(1-4-3-2-1)..

Фух..
Вроде нигде не врал..

P.S. Я уверен, что есть классный вариант, который позволяет "Найти количество циклов веса M в неориентированном графе" за какую-то хорошую сложность..

[Sibedir]

Сообщение от Poma][a

Вот.. Давайте скажем, что путем из вершины A в вершину B является набор вершин W(A-Vi-Vj-..-Vk-B). Дак вот, пусть путь из 1 в 4 равен W(1-4). Теперь из вершины 4 можно сходить в вершину 1. Тогда мы должны запомнить, что мы использовали путь W(1-2-3-4)+W(4-1) = W(1-2-3-4-1). И больше его никогда не трогать.)

Понятно. Но сложность действительно аграменная. Да и реализация сложновата и запутана. У меня терпения не хватило.

Кстати, проблема была в том, что одной длиной путь идентифицировать не удавалось. Ибо могут быть пересекающиеся пути одной длины (куча ветвлений одинаковой длины).

[Poma][a]

Ну.. Сложность O(V^3)..
Если забыть про матрицу, то можно бахнуть O(V*E)
А реализация.. Почти обычный dfs.. Только те идиотские развилки.

[Sibedir]

А ну вот, да. вроде работает

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  _COUNT = 16;
  _HIGH  = _COUNT - 1;

type
  TFlags  = array [0.._HIGH] of Boolean;
  TCNT    = array [0.._HIGH] of Integer;
  TGraph  = array [0.._HIGH] of array [0.._HIGH] of Integer;

var
  cnt: TCNT;
  v: TGraph;

// Создаёт ребра
procedure SetEdge (aV1, aV2: Integer);
begin
  v [aV1][aV2] := 1;
  v [aV2][aV1] := 1;
end;

procedure dfs (use: TFlags; k, anc: Integer; wave: Integer = 0);
var
  i: Integer;
begin
  if (v[k][anc] <> 0) then Inc(cnt[wave]);

  use[k] := True;

  for i := 0 to _HIGH do begin
    if (not use[i]) and (v[k][i] <> 0) then begin
      use[i] := True;
      dfs (use, i, anc, wave+1);
      use[i] := False;
    end;
  end;
end;

procedure main;
var
  i, j: Integer;
  use: TFlags;
begin
  for i := 0 to _HIGH do begin
    for j := 0 to _HIGH do use[j] := False;
    use[i] := True;
    dfs (use, i, i);
  end;
end;

// -----------------------------------------------------------------------------
var
  i, j: Integer;
  s: String;
begin
  // Обнуляем
  for i := 0 to _HIGH do
    for j := 0 to _HIGH do
      v[i][j] := 0;

  // Заполняем
  SetEdge ( 0,  1); //  1
  SetEdge ( 0,  2); //  2
  SetEdge ( 0,  5); //  3
  SetEdge ( 3,  4); //  4
  SetEdge ( 3,  5); //  5
  SetEdge ( 4,  6); //  6
  SetEdge ( 4,  8); //  7
  SetEdge ( 5,  6); //  8
  SetEdge ( 5, 14); //  9
  SetEdge ( 5, 15); // 10
  SetEdge ( 6, 10); // 11
  SetEdge ( 8,  6); // 12
  SetEdge (10, 12); // 13
  SetEdge (11, 12); // 14
  SetEdge (12, 13); // 15
  SetEdge (13, 14); // 16

  SetEdge ( 1, 7);
  SetEdge ( 7, 8);

//  Graph[4,3] := False;

  main;

  // Выводим
  j := 0;
  for i := 2 to _HIGH do begin
    j := j + cnt[i] div ((i+1)*2);
    s := 'cnt[' + IntToStr(i) + ']: ' + IntToStr(j);
    Writeln (s);
  end;
  Writeln ('---------------');
  Writeln (j);
  Readln;
end.

// -----------------------------------------------
Нет. показалось.
Лишнего насчитывает.

[Poma][a]

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  _COUNT = 6;
  _HIGH  = _COUNT - 1;

type
  TFlags  = array [0.._HIGH] of Boolean;
  TCNT    = array [0.._HIGH] of Integer;
  TGraph  = array [0.._HIGH] of array [0.._HIGH] of Integer;

var
  cnt: TCNT;
  v: TGraph;

// Создаёт ребра
procedure SetEdge (aV1, aV2: Integer);
begin
  v [aV1][aV2] := 1;
  v [aV2][aV1] := 1;
end;

procedure dfs (use: TFlags; k, anc: Integer; wave: Integer);
var
  i: Integer;
begin
  if (v[k][anc] <> 0) then Inc(cnt[wave+1]);

  use[k] := True;

  for i := 0 to _HIGH do begin
    if (not use[i]) and (v[k][i] <> 0) then begin
      use[i] := True;
      dfs (use, i, anc, wave+1);
      use[i] := False;
    end;
  end;
end;

procedure main;
var
  i, j: Integer;
  use: TFlags;
begin
  for i := 0 to _HIGH do begin
    for j := 0 to _HIGH do use[j] := False;
    use[i] := True;
    dfs (use, i, i, 0);
  end;
end;

// -----------------------------------------------------------------------------
var
  i, j: Integer;
  s: String;
begin
  // Обнуляем
  for i := 0 to _HIGH do
    for j := 0 to _HIGH do
      v[i][j] := 0;

  // Заполняем
  SetEdge ( 0,  1); //  1
  SetEdge ( 1,  2); //  2
  SetEdge ( 2,  3); //  3
  SetEdge ( 3,  4); //  4
  SetEdge ( 4,  5); //  5
  SetEdge ( 5,  0); //  7
  SetEdge ( 3,  0); //  8
//  Graph[4,3] := False;

  main;

  // Выводим
  j := 0;
  for i := 2 to _HIGH+1 do begin
    j := cnt[i] div (i*2);
    s := 'cnt[' + IntToStr(i) + ']: ' + IntToStr(j);
    Writeln (s);
  end;
  Writeln ('---------------');
  Writeln (j)
end.

// ------

Я чуть-чуть поправил.. Вроде работает