Форум программистов, компьютерный форум, киберфорум
Наши страницы
Free Pascal
Войти
Регистрация
Восстановить пароль
 
codcw
0 / 0 / 1
Регистрация: 22.12.2017
Сообщений: 16
#1

Поиск гамильтонова цикла в ориентированном графе

23.05.2018, 01:55. Просмотров 164. Ответов 4

Честно пытался искать по форуму и не только, но так толком ничего и не нашел :\
Необходимо узнать, есть ли в орграфе гамильтонов цикл или нет. Граф задан матрицей смежности.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.05.2018, 01:55
Ответы с готовыми решениями:

поиск паросочетания в графе
добрый вечер! вот это граф который имеет парные вершины. программа должна...

Поиск пути в графе
Написал программу для поиска кратчайшего пути от заданной точки ко всем...

Поиск максимального потока в графе
Прошу напишите код программы для поиска максимального потока в графе на паскале

Поиск в графе с учетом направлений
Дан граф с учетом направлений --123456 --______ 1|-00011 2|1-0000 3|00-000...

Поиск в графе в ширину заданном списками инциденций
Добрый день. Пытаюсь написать функцию поиска в ширину в графе, заданным...

4
volvo
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
25983 / 17424 / 6910
Регистрация: 22.10.2011
Сообщений: 30,668
Записей в блоге: 6
23.05.2018, 10:19 #2
В самом низу снизу страницы есть "Похожие темы", так вот третья ссылка снизу ведет к решению задачи: Поиск гамильтонова цикла в графе

А ты говоришь искал...
1
codcw
0 / 0 / 1
Регистрация: 22.12.2017
Сообщений: 16
23.05.2018, 12:58  [ТС] #3
но это не совсем то, что нужно - там программа для неориентированного графа. а мне нужна программа для ориентированного графа, да и программа написана так, что мне в ней очень сложно разобраться
0
ФедосеевПавел
Модератор
3602 / 1985 / 825
Регистрация: 01.02.2015
Сообщений: 6,616
24.05.2018, 12:28 #4
Вывод вершин - самостоятельно подшаманите
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
(*
 
http://rain.ifmo.ru/cat/view.php/theory/graph-circuits-cuts/hamiltonian-2005
Алгоритм нахождения гамильтонова цикла
 
Рассмотрим рекурсивную функцию searchHamiltonianCycle, которая возвращает true, если граф является гамильтоновым, и false в противном случае.
 
 
  searchHamiltonianCycle(0, 0, numberOfVertices);
  bool searchHamiltonianCycle(int v, int w, int d) {
1*  if (d == 1 && w прринадлежит Adj[v]) return true;
2   visited[v] = true;
3   for (для) всех вершин t принадлежит Adj[v]
4     if (!visited[t])
5       if (searchHamiltonianCycle(t, w, d-1))
6         return true;
7*  visited[v] = false;
8   return false;
  }
 
    numberOfVertices — число вершин в графе
    v — последняя найденная вершина
    w — начальная вершина (с нее начинается поиск)
    d — оставшаяся длина гамильтонова цикла
 
Данный алгоритм напоминает алгоритм поиска в глубину (DFS). Основные отличия отмечены красным цветом (символом '*'):
1. функция принимает начальную вершину w и длину гамильтонова цикла в качестве второго и третьего параметров соответственно;
2. в строке 1, функция проверяет, все ли вершины были посещены (d == 1), и если это так, то существует ли ребро, соединяющее
    начальную вершину с конечной. Если оба условия выполнены, то гамильтонов цикл найден;
3. в строке 7, функция переустанавливает значение маркера visited, прежде чем возвратит значение, означающие неуспех.
*)
 
program HamiltonCycle;
 
type
  TMatrixAdjacent = array of array of integer;
  TArray = array of integer;
 
  function ReadMatrixAdjacentFromFile(s: string; var M: TMatrixAdjacent;
  var NVertex: integer): boolean;
  var
    f: Text;
    i, j: integer;
  begin
    Assign(f, s);
    reset(f);
    readln(f, NVertex);
    SetLength(M, NVertex, NVertex);
    for i := 0 to NVertex - 1 do
    begin
      for j := 0 to NVertex - 1 do
        Read(f, M[i, j]);
      readln(f);
    end;
    Close(f);
    ReadMatrixAdjacentFromFile := True;
  end;
 
  procedure ShowMatrix(const M: TMatrixAdjacent; n: integer);
  var
    i, j: integer;
  begin
    for i := 0 to n - 1 do
    begin
      for j := 0 to n - 1 do
        Write(M[i, j]: 2);
      writeln;
    end;
  end;
 
  {функция определяет - орграф или не орграф по симметричности матрицы смежности}
  function IsDigraph(const M: TMatrixAdjacent; NVertex: integer): boolean;
  var
    i, j: integer;
    Res:  boolean;
  begin
    Res := True;
    for i := 0 to NVertex - 1 do
      for j := 0 to NVertex - 1 do
        Res := Res and (M[i, j] = M[j, i]);
    IsDigraph := Res;
  end;
 
{
Степень вершины (англ. degree, также валентность, англ. valency)
в теории графов — количество рёбер графа G, инцидентных вершине x.
При подсчёте степени ребро-петля учитывается дважды.
}
  {для неориентированного графа}
  function deg(v: integer; const M: TMatrixAdjacent; NVertex: integer): integer;
  var
    j: integer;
  begin
    deg := 0;
    for j := 0 to NVertex - 1 do
      if M[v, j] <> 0 then
        Inc(deg);
    if M[v, v] <> 0 then
      Inc(deg);
  end;
 
  {
  полустепень. количество входящих рёбер орграфа.
  }
  function indegree(v: integer; const M: TMatrixAdjacent; NVertex: integer): integer;
  var
    j: integer;
  begin
    indegree := 0;
    for j := 0 to NVertex - 1 do
      if M[v, j] <> 0 then
        Inc(indegree);
  end;
 
  {
  полустепень. количество исходящих рёбер орграфа.
  }
  function outdegree(v: integer; const M: TMatrixAdjacent; NVertex: integer): integer;
  var
    i: integer;
  begin
    outdegree := 0;
    for i := 0 to NVertex - 1 do
      if M[v, i] <> 0 then
        Inc(outdegree);
  end;
 
  {
   Необходимое условие существования гамильтонова пути в неориентированном графе:
   если неориентированный граф G содержит гамильтонов цикл, тогда в нём не существует
   ни одной вершины x(i) с локальной степенью p(x(i)) < 2.
  }
  function HamiltonianProperty(const M: TMatrixAdjacent; NVertex: integer): boolean;
  var
    x, y: integer;
    Res:  boolean;
  begin
    Res := (NVertex >= 3);
    if Res then
    begin
      for x := 0 to NVertex - 1 do
        Res := Res and (deg(x, M, NVertex) >= 2);
    end;
    HamiltonianProperty := Res;
  end;
 
  {
  условие Дирака существования гамильтонова пути:
  пусть p — число вершин в данном графе и p>=3;
  если степень каждой вершины не меньше, чем p/2, то данный граф — гамильтонов.
  Это достаточное условие не является необходимым.
 
  Условие - для простого графа (Простой граф — граф, в котором нет кратных рёбер и петель.)
  }
  function Dirac(const M: TMatrixAdjacent; NVertex: integer): boolean;
  var
    Res: boolean;
    v: integer;
  begin
    Res := (NVertex >= 3);
    if Res then
    begin
      for v := 0 to NVertex - 1 do
        Res := Res and (deg(v, M, NVertex) >= (NVertex div 2));
    end;
    Dirac := Res;
  end;
 
  {
  Условие Оре:
   пусть p — количество вершин в данном графе и p>2.
   Если для любой пары несмежных вершин (x, y) выполнено неравенство
   deg(x) + deg(y) >= p, то данный граф — гамильтонов (другими словами:
   сумма степеней любых двух несмежных вершин не меньше общего числа вершин в графе).
  }
  function Ore(const M: TMatrixAdjacent; NVertex: integer): boolean;
  var
    x, y: integer;
    Res:  boolean;
  begin
    Res := (NVertex >= 3);
    if Res then
    begin
      for x := 0 to NVertex - 1 do
        for y := 0 to NVertex - 1 do
          if (M[x, y] = 0) and (M[y, x] = 0) then
            Res := Res and (deg(x, M, NVertex) + deg(y, M, NVertex) >= NVertex);
    end;
    Ore := Res;
  end;
 
  function FindHamiltonianCycle(M: TMatrixAdjacent; NVertex: integer): boolean;
  var
    Visited: array of boolean;
    Path: TArray;
 
    function searchHamiltonianCycle(v, w, d: integer): boolean;
    var
      t: integer;
    begin
      if (d = 1) and (M[v, w] = 1) then
      begin
        Path[NVertex - d] := v;
        searchHamiltonianCycle := True;
        exit;
      end;
      Visited[v] := True;
      for t := 0 to NVertex - 1 do
      begin
        if M[v, t] = 0 then
          continue;
        if not Visited[t] then
          if searchHamiltonianCycle(t, w, d - 1) then
          begin
            Path[NVertex - d] := v;
            searchHamiltonianCycle := True;
            exit;
          end;
      end;
      Visited[v] := False;
      searchHamiltonianCycle := False;
    end;
 
  var
    i: integer;
  begin
    SetLength(Path, NVertex);
    SetLength(Visited, NVertex);
    for i := 0 to NVertex - 1 do
      Visited[i] := False;
    FindHamiltonianCycle := searchHamiltonianCycle(0, 0, NVertex);
    if FindHamiltonianCycle then
      for i := 0 to NVertex - 1 do
        Write(Path[i]: 3);
    writeln;
  end;
 
var
  MA: TMatrixAdjacent;
  NVertex: integer;
begin
  ReadMatrixAdjacentFromFile('MatrixAdjacent.txt', MA, NVertex);
  ShowMatrix(MA, NVertex);
  Write('The Hamiltonian graph property gives ');
  if HamiltonianProperty(MA, NVertex) then
    writeln('positive result.')
  else
    writeln('negative result.');
  Write('The Dirac condition of Hamiltonian graph gives ');
  if Dirac(MA, NVertex) then
    writeln('positive result.')
  else
    writeln('negative result.');
  Write('The Ore condition of Hamiltonian graph gives ');
  if Ore(MA, NVertex) then
    writeln('positive result.')
  else
    writeln('negative result.');
  writeln('Hamiltonian:');
  if FindHamiltonianCycle(MA, NVertex) then
    writeln('Exist')
  else
    writeln('No exist');
end.
Матрица смежности - в файле MatrixAdjacent.txt:
Код
16
1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1
1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1
1
codcw
0 / 0 / 1
Регистрация: 22.12.2017
Сообщений: 16
31.05.2018, 21:08  [ТС] #5
Большое спасибо за отзывчивость, но это все-таки не совсем то, я для своей ситуации нашел отличный алгоритм - возводить матрицу в степень, равную её размерности и следить за заполнением главной диагонали( если заполнена - значит гамильтонов цикл присутствует ). Ещё раз большое спасибо, код возведения в степень прилагаю.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure gamilton(var a,b,x:matr; n:integer);
var i,j,k,z:integer;
begin
for i:=1 to n do
 for j:=1 to n do
 b[i,j]:=a[i,j];
 for z:=1 to n-1 do begin
for i:=1 to n do
 for j:=1 to n do
 begin
  x[i,j]:=0;
  for k:=1 to n do
  x[i,j]:=x[i,j]+a[i,k]*b[k,j];
 end;
   for i:=1 to n do
 for j:=1 to n do  a[i,j]:=x[i,j];
 writeln;
 for i:=1 to n do begin
 for j:=1 to n do
 write(x[i,j]);
 writeln; end;
 end;
end;
0
31.05.2018, 21:08
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
31.05.2018, 21:08

Разработайте программу реализующую поиск в ширину в графе из заданной вершины
Лекции пропустил теперь незнаю как написать=( выручайте.. 1.Разработайте...

Вывод результата в теле цикла и за пределами цикла???
Вывод результата в теле цикла и за его пределами: 1. как это влияет на...

Поиск гамильтонова цикла в графе
Написать программу поиска гамильтонова цикла в графе.


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru