Всем доброе время суток. Нужна помощь алгоритмом или кодом поиска циклов в неориентированном графе. Граф задан матрицей смежности, и списком ребер. В общем есть программа для определения числа связности графа и компонент связности, а вот как этот алгоритм применить к поиску циклов не знаю((
legend-muay
20.10.2009 21:39
Вот код для определения числа связности. В задании написанно, что этот же алгоритм применяется и для определения циклов. В общем у меня не получилось переделать его под циклы((
{ Определение числа связности } //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
23.10.2009 17:40
Нашел в инете код поиска циклов в неориентированном графе, может кому-то еще понадобится
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;