Помощь - Поиск - Пользователи - Календарь
Полная версия: Поиск циклов в неориентированном графе
Форум «Всё о Паскале» > 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.

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