Алгоритм поиска элементарных циклов в неориентированном графе - Алгоритмы - Ответ 10576145

function CompareCircles(i1,i2:integer):Boolean;
var i,j,k:integer;
begin
Result:=False;
if circles[i1].nel<>circles[i2].nel then exit;
k:=0;
for i:=0 to circles[i1].nel-2 do
   begin
   for j:=0 to circles[i2].nel-2 do
      begin
      if circles[i1].els[i]=circles[i2].els[j] then k:=k+1;
      end;
   end;
if k=(circles[i1].nel-1) then Result:=True;
end;
 
procedure push(k:integer);
begin
stack[t]:=k;t:=t+1;
end;
 
procedure pop(k:integer);
begin
t:=t-1;
end;
 
procedure DFS(k,v:integer);
var i,j,m,i1,j1:integer;
begin
push(k);
visited[k]:=1;
for i:=0 to np-1 do
    begin
    if i=k then continue;
    if i=v then continue;
    if (visited[i]=1) and (adj[i,k]<>0) then //--если не сама с себя
       begin
       for j:=0 to t-1 do
          begin
          circles[ncl].els[j]:=stack[j];
          end;
       for j:=0 to t-1 do if stack[j]=i then break;
       for m:=j to t-1 do circles[ncl].els[m-j]:=stack[m]; //---переносим цикл из стека
       circles[ncl].els[t-j]:=i;
       circles[ncl].nel:=t-j+1;
//-------------проверка, а может такой цикл уже есть?
       j1:=0;
       for i1:=0 to ncl-1 do
          begin
          if CompareCircles(i1,ncl)=True then begin j1:=1;break;end;
          end;
       continue;
       end;
    if adj[i,k]<>0 then DFS(i,k);
    end;
visited[k]:=0;
pop(k);
end;