1 { Version 050625. Copyright � Alexey A.Chernobaev, 1996-2005 }
2 
3 unit HamilCyc;
4 
5 interface
6 
7 {$I VCheck.inc}
8 
9 uses
10   ExtType, AttrType, Graphs, Int16v, Aliasv, Boolv, Pointerv, MultiLst, VectErr;
11 
FindHamiltonCyclesnull12 function FindHamiltonCycles(G: TGraph; FromVertex: TVertex; N: Integer;
13   EdgePaths: TMultiList): Integer;
14 {
15   ������� �������� ���������� ������������� ������ (������, ���������� �����
16   ������ ������� ����� ����� ���� ���) � ��������������� ����� G, ������� �
17   FromVertexIndex-�������; ���� N <= 0, �� ������������ ��� �����; ���� N > 0,
18   �� ������������ min(N, <���������� ������>) ������; ������� ����������
19   ���������� ��������� ������; ����� ������������ � ������������ EdgePaths.
20 }
21 
22 implementation
23 
24 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
FindHamiltonCyclesnull25 function FindHamiltonCycles(G: TGraph; FromVertex: TVertex; N: Integer;
26   EdgePaths: TMultiList): Integer;
27 label
28   Loop;
29 const
30   OriginalIndex = 'HamilCyc';
31 var
32   I, J, K, M, OriginalIndexOfs: Integer;
33   TempGraph: TGraph;
34   OutArcsList, InArcsList: TMultiList;
35   FromIndex, InDegrees, OutDegrees, BackArcsCount: TIntegerVector;
36   CurrentPath, OutArcs, BackVerticesList, BackArcsList: TClassList;
37   AllowedVertices, AllowedEdges: TBoolVector;
38   CurrentVertex, NewVertex: TVertex;
39   E1, E2: TEdge;
40   ExitFlag, B: Bool;
41 
GraphReductionnull42   function GraphReduction(FromVertex, ToVertex: TVertex; Arc: TEdge): Bool;
43   { ���������� �������� �����, ������� ������ ����� ����� Arc (� ���������������
44     ������� ToVertex) ��� ����������� �����, ������ �� ������� FromVertex;
45     ���� �����������, ��� ��� ����� ������ ������� �� ����������, �� �������
46     ���������� True }
47   var
48     I, J, K, L, BackArcs, RecursionCount: Integer;
49     ArcList, NewFromVertexList, NewToVertexList: TClassList;
50     E: TEdge;
51     V, Neighbour: TVertex;
52   begin
53     { 1. ��������� ��� ����������� ����, �������� � ToVertex, �� �����������
54       ���, ��������� �� ��� ����������� ������ ��� FromVertex }
55     Result:=True;
56     BackArcs:=0;
57     RecursionCount:=0;
58     NewFromVertexList:=TClassList.Create;
59     NewToVertexList:=TClassList.Create;
60     try
61       I:=ToVertex.Index;
62       ArcList:=InArcsList[I];
63       for J:=0 to ArcList.Count - 1 do begin
64         E:=TEdge(ArcList[J]);
65         if AllowedEdges[E.Index] then begin
66           V:=E.OtherVertex(ToVertex);
67           if V <> FromVertex then begin
68             K:=V.Index;
69             if AllowedVertices[K] then begin
70               { ���� � ToVertex ������ ���� �� ��������� ����������� �������,
71                 �� ����������� � FromVertex, � ��� �������� ������������
72                 �����, ��������� �� ���� �������, �� ��� ������� }
73               L:=OutDegrees[K];
74               if L = 1 then Exit; { finally �����������! }
75               if L = 2 then NewFromVertexList.Add(V);
76               OutDegrees.DecItem(K, 1);
77               InDegrees.DecItem(I, 1);
78               BackArcsList.Add(E);
79               AllowedEdges[E.Index]:=False;
80               Inc(BackArcs);
81             end;
82           end;
83         end;
84       end;
85       { 2. ��������� ��� ����������� ����, ��������� �� FromVertex, ����� Arc }
86       I:=FromVertex.Index;
87       ArcList:=OutArcsList[I];
88       for J:=0 to ArcList.Count - 1 do begin
89         E:=TEdge(ArcList[J]);
90         if (E <> Arc) and AllowedEdges[E.Index] then begin
91           V:=E.OtherVertex(FromVertex);
92           K:=V.Index;
93           { ���� � �������� ������� ������ ������������ ����������� ����,
94             �� ��� ������� }
95           L:=InDegrees[K];
96           if L = 1 then Exit; { finally �����������! }
97           if L = 2 then NewToVertexList.Add(V);
98           OutDegrees.DecItem(I, 1);
99           InDegrees.DecItem(K, 1);
100           BackArcsList.Add(E);
101           AllowedEdges[E.Index]:=False;
102           Inc(BackArcs);
103         end;
104       end;
105       { 3. ���������� �������� ���������� }
106       for I:=0 to NewFromVertexList.Count - 1 do begin
107         V:=TVertex(NewFromVertexList[I]);
108         ArcList:=OutArcsList[V.Index];
109         for J:=0 to ArcList.Count - 1 do begin
110           E:=TEdge(ArcList[J]);
111           if AllowedEdges[E.Index] then begin
112             Neighbour:=E.OtherVertex(V);
113             if AllowedVertices[Neighbour.Index] then begin
114               Inc(RecursionCount);
115               if GraphReduction(V, Neighbour, E) then Exit;
116             end;
117           end;
118         end;
119       end;
120       for I:=0 to NewToVertexList.Count - 1 do begin
121         V:=TVertex(NewToVertexList[I]);
122         ArcList:=OutArcsList[V.Index];
123         for J:=0 to ArcList.Count - 1 do begin
124           E:=TEdge(ArcList[J]);
125           if AllowedEdges[E.Index] then begin
126             Neighbour:=E.OtherVertex(V);
127             if AllowedVertices[Neighbour.Index] then begin
128               Inc(RecursionCount);
129               if GraphReduction(Neighbour, V, E) then Exit;
130             end;
131           end;
132         end;
133       end;
134       Result:=False;
135     finally
136       for I:=0 to RecursionCount - 1 do
137         Inc(BackArcs, BackArcsCount.Pop);
138       BackArcsCount.Add(BackArcs);
139       NewFromVertexList.Free;
140       NewToVertexList.Free;
141     end;
142   end;
143 
144   procedure RestoreGraph;
145   { ��������� ����������� ����� }
146   var
147     I: Integer;
148     E: TEdge;
149   begin
150     for I:=1 to BackArcsCount.Pop do begin
151       E:=TEdge(BackArcsList.Pop);
152       AllowedEdges[E.Index]:=True;
153       OutDegrees.IncItem(E.V1.Index, 1);
154       InDegrees.IncItem(E.V2.Index, 1);
155     end;
156   end;
157 
158 begin
159   {$IFDEF CHECK_GRAPHS}
160   if not (Directed in G.Features) then TGraph.Error(SMethodNotApplicable);
161   {$ENDIF}
162   Result:=0;
163   EdgePaths.Clear;
164   M:=G.VertexCount;
165   if M > 1 then begin
166     { ���� ���� �������, � ������� �� ������� �� ���� ����, ���� �� �������
167       �� ������� �� ���� ����, �� ����������� ���� �� ���������� }
168     for I:=0 to M - 1 do begin
169       G[I].GetInOutDegree(J, K);
170       if (J = 0) or (K = 0) then Exit;
171     end;
172     TempGraph:=TGraph.Create;
173     try
174       TempGraph.AssignSceleton(G);
175       OriginalIndexOfs:=TempGraph.CreateEdgeAttr(OriginalIndex, AttrInt32);
176       for I:=0 to TempGraph.EdgeCount - 1 do
177         TempGraph.Edges[I].AsInt32ByOfs[OriginalIndexOfs]:=I;
178       TempGraph.Features:=[Directed];
179       FromVertex:=TempGraph[FromVertex.Index];
180       { ������� � TempGraph ����� � ������� ����� }
181       TempGraph.RemoveLoops;
182       TempGraph.RemoveParallelEdges;
183       { �������� TempGraph: ���� � ��������� ������� u ����� ������ ���� ����
184         �� ������� v, �� ������� ��� ����, ��������� �� v, ����� ���� (v, u);
185         ���� ��� ���� ���������� ������������� �������, �� ����������� ����
186         �� ���������� }
187       AllowedVertices:=TBoolVector.Create(M, True);
188       try
189         repeat
190           ExitFlag:=True;
191           for I:=0 to M - 1 do begin
192             CurrentVertex:=TempGraph[I];
193             if AllowedVertices[CurrentVertex.Index] then begin
194               B:=False;
195               for J:=0 to CurrentVertex.Degree - 1 do begin
196                 E1:=CurrentVertex.IncidentEdge[J];
197                 if E1.V2 = CurrentVertex then begin
198                   NewVertex:=E1.V1;
199                   if B then begin
200                     B:=False;
201                     Break;
202                   end;
203                   B:=True;
204                   E2:=E1;
205                 end;
206               end;
207               if B then begin
208                 { ������� "������" ��������� �� v ���� }
209                 for J:=NewVertex.Degree - 1 downto 0 do begin
210                   E1:=NewVertex.IncidentEdge[J];
211                   if (E1 <> E2) and (E1.V1 = NewVertex) then begin
212                     K:=E1.V2.InDegree;
213                     if K = 1 then Exit; { ��� ������������ ����� }
214                     if K = 2 then begin
215                       ExitFlag:=False;
216                       AllowedVertices[E1.V2.Index]:=True;
217                     end;
218                     E1.Free;
219                   end;
220                 end;
221               end;
222               AllowedVertices[CurrentVertex.Index]:=False;
223             end;
224           end;
225         until ExitFlag;
226         { �������� ����� ��������� }
227         OutArcsList:=TMultiList.Create(TClassList);
228         InArcsList:=nil;
229         FromIndex:=nil;
230         InDegrees:=nil;
231         OutDegrees:=nil;
232         BackArcsCount:=nil;
233         CurrentPath:=nil;
234         BackVerticesList:=nil;
235         BackArcsList:=nil;
236         AllowedEdges:=nil;
237         try
238           InArcsList:=TMultiList.Create(TClassList);
239           FromIndex:=TIntegerVector.Create(M, 0);
240           InDegrees:=TIntegerVector.Create(M, 0);
241           OutDegrees:=TIntegerVector.Create(M, 0);
242           BackArcsCount:=TIntegerVector.Create(0, 0);
243           CurrentPath:=TClassList.Create;
244           BackVerticesList:=TClassList.Create;
245           BackArcsList:=TClassList.Create;
246           AllowedEdges:=TBoolVector.Create(TempGraph.EdgeCount, True);
247           AllowedVertices.FillValue(True);
248           TempGraph.GetInArcsList(InArcsList);
249           TempGraph.GetOutArcsList(OutArcsList);
250           for I:=0 to M - 1 do begin
251             InDegrees[I]:=InArcsList[I].Count;
252             OutDegrees[I]:=OutArcsList[I].Count;
253           end;
254           CurrentVertex:=FromVertex;
255         Loop:
256           I:=CurrentVertex.Index;
257           AllowedVertices[I]:=False;
258           OutArcs:=OutArcsList[I];
259           { ���� ���������� ���������� ����� ����, �� �������, �� ��������� �� ��
260             ������� CurrentVertex ������� FromVertex }
261           if CurrentPath.Count = M - 1 then
262             for J:=0 to OutArcs.Count - 1 do begin
263               E1:=TEdge(OutArcs[J]);
264               NewVertex:=E1.OtherVertex(CurrentVertex);
265               if NewVertex = FromVertex then begin { ����� ����������� ���� }
266                 CurrentPath.Add(G.Edges[E1.AsInt32ByOfs[OriginalIndexOfs]]);
267                 EdgePaths.AddAssign(CurrentPath);
268                 Inc(Result);
269                 if Result = N then Exit; { ����� N ������������� ������ }
270                 CurrentPath.Grow(-1);
271               end;
272             end
273           else begin
274             for J:=FromIndex[I] to OutArcs.Count - 1 do begin
275               E1:=TEdge(OutArcs[J]);
276               if AllowedEdges[E1.Index] then begin
277                 NewVertex:=E1.OtherVertex(CurrentVertex);
278                 K:=NewVertex.Index;
279                 if AllowedVertices[K] then begin { ���������� ������� }
280                   { ���������� �������� �����; ���� �����������, ��� ��� ������
281                     ������� NewVertex ������� �� ����� ������������, �� �������
282                     �� ����� � ���������� ������� }
283                   if GraphReduction(CurrentVertex, NewVertex, E1) then begin
284                     RestoreGraph;
285                     Continue;
286                   end;
287                   FromIndex[I]:=J + 1;
288                   { ���������� ���������� ��� �������� }
289                   CurrentPath.Add(G.Edges[E1.AsInt32ByOfs[OriginalIndexOfs]]);
290                   BackVerticesList.Add(CurrentVertex);
291                   { ���������� ����� }
292                   AllowedVertices[K]:=False;
293                   CurrentVertex:=NewVertex;
294                   goto Loop;
295                 end;
296               end;
297             end;
298           end;
299           { ��� ����������� }
300           if BackVerticesList.Count > 0 then begin
301             I:=CurrentVertex.Index;
302             FromIndex[I]:=0;
303             AllowedVertices[I]:=True;
304             CurrentPath.Grow(-1);
305             CurrentVertex:=TVertex(BackVerticesList.Pop);
306             RestoreGraph;
307             goto Loop;
308           end;
309         finally
310           InArcsList.Free;
311           OutArcsList.Free;
312           FromIndex.Free;
313           InDegrees.Free;
314           OutDegrees.Free;
315           BackArcsCount.Free;
316           CurrentPath.Free;
317           BackVerticesList.Free;
318           BackArcsList.Free;
319           AllowedEdges.Free;
320         end;
321       finally
322         AllowedVertices.Free;
323       end;
324     finally
325       TempGraph.Free;
326     end;
327   end;
328 end;
329 {$IFDEF NOWARN}{$WARNINGS ON}{$ENDIF}
330 
331 end.
332