Помощь - Поиск - Пользователи - Календарь
Полная версия: Поиск циклов в неориентированном графе
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
legend-muay
Всем доброе время суток. Нужна помощь алгоритмом или кодом поиска циклов в неориентированном графе. Граф задан матрицей смежности, и списком ребер. В общем есть программа для определения числа связности графа и компонент связности, а вот как этот алгоритм применить к поиску циклов не знаю((
legend-muay
Вот код для определения числа связности. В задании написанно, что этот же алгоритм применяется и для определения циклов. В общем у меня не получилось переделать его под циклы((

{ Определение числа связности }
//a-матрица смежности
//mark-массив с метками для вершин, если вершина пройдена тогда 1, иначе 0
//count_rec-кол-во вершин в связном компоненте
//count_c-число связности
procedure step(c1,v:byte);
var jin:byte;
begin
 mark[v]:=1;
 for jin:=1 to n do
  if (mark[jin]=0) and (a[v,jin]<>0) then
   begin
    inc(count_rec);
    lbl[c1,count_rec]:=jin;
    step(c1,jin);
   end;
end;

procedure svyaznost(nin:byte;var countC:byte);
var iin:byte;
begin
 for iin:=1 to nin do mark[iin]:=0;
 countC:=0;
 for iin:=1 to nin do
  if mark[iin]=0 then
   begin
    count_rec:=0;
    inc(countC);
    inc(count_rec);
    lbl[countC,count_rec]:=iin;
    step(countC,iin);
    lbl[countC,0]:=count_rec;
   end;
end;
{ End 
      lbl-связные компоненты}

legend-muay
Нашел в инете код поиска циклов в неориентированном графе, может кому-то еще понадобится

const
 n0=5; {vershini}
var
 m:integer; {rebra}
 n:byte; {vershiny}
 graf:array[1..n0,1..n0] of byte;{матрица смежности}
 DOP:array[1..n0] of boolean;
 X:array[1..n0] of byte;{здесь будут храниться вершины цикла}
 i,j,k:byte;

procedure cycle(i:byte);
var u,j:byte;
begin
  for u:=1 to n do
    if graf[X[i-1],u]=1 then
      begin
        if (u=k) AND (i>=4)  then {nashli cikl}
          begin
            for j:=1 to i-1 do
              write(X[j],' ');
            writeln(k);
          end
        else if DOP[u] then
             begin
               X[i]:=u; DOP[u]:=false;
               cycle(i+1);
               {vozvrat}
               X[i]:=0;
               DOP[u]:=true;
             end;
      end;
end;

BEGIN {main}
  for i:=1 to n0 do
  for j:=1 to n0 do
    graf[i,j]:=0;

  for i:=1 to n0 do
    begin
      DOP[i]:=true;
      X[i]:=0;
    end; 

  Write('Vvedite kolvo vershin n= '); readln(n);
  Write('Vvedite kolvo reber m= '); readln(m);
  for i:=1 to m do
  begin
    Write('Vvedit cherez probil vershini ',i,' rebra: '); Readln(j,k);
    graf[j,k]:=1;
    graf[k,j]:=1;
  end; 

 Write('Vvedite nachalo cikla k='); readln(k);
 X[1]:=k; DOP[k]:=false;
 cycle(2);{zapolnjaem X dalshe}
 readln;
END.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.