uses crt; const max=100; var Matrix:array [1..max,1..max] of byte; i,j,n,r,time,k:integer; num,ftr,Q:array [1..max] of integer; tn,tk:array[1..max] of integer; procedure dfs(r:integer); var i,j,k,p:integer;
begin time:=time+1; tn[i]:=time; num [i]:=k; k:=k+1;
for i:=1 to n do begin if num[i]=0 then begin ftr[i]:=i; dfs(j); end; time:=time+1; tk[i]:=time
end;
end;
begin clrscr;
writeln('----Поиск в глубину-----'); write('Введите количество вершин графа:'); readln(n); writeln('Заполнение матрицы смежности'); for i:=1 to n do for j:=1 to n do begin Write('(',i,',',j,')='); read(Matrix[i,j]); if Matrix[i,j] <> 0 then Matrix[i,j]:=1; end; //вывод матрицы смежностиж; writeln('Матрица смежности'); for i:=1 to n do begin for j:=1 to n do write(Matrix[i,j],' '); writeln; end; writeln;
//процедура bfs; writeln('Результат dfs'); for i:=1 to n do begin num[i]:=0; ftr[i]:=0; time:=0; k:=1; end; for r:=1 to n do if num[r]=0 then dfs®;
//вывод массивов num ftr; write('num: '); for i:=1 to n do write(num[i],' '); writeln; write('ftr:'); for i:=1 to n do write(ftr[i],' '); writeln; readln; end.
Псевдокод кинула по которому написано
Федосеев Павел
27.04.2012 1:09
Будь внимательнее, ведь там всё просто. Результат обхода графа - список вершин в порядке их посещения. Если вершинам присваивать номера во время обхода, получим тот же искомый список. Здесь в FAQ'е есть небольшая статья про графы. Там dfs описывается просто:
{ рекурсивный вариант } procedure dfs(v:integer); var i:integer; begin Nnew[v]:=false; {помечаем вершину как посещённую} write(v:2); {такое своеобразное формирование списка посещённых вершин} for i:=1 to n do {"пробегаемся" по строке матрицы смежностей и ищем рёбра к непосещённым вершинам} if (a[v,i]<>0) and Nnew[i] then dfs(i); {если такая вершина нашлась, то выполняем и для неё обход в глубину} end;
uses crt; const max=7; type TMatrix = array [1..max,1..max] of byte; TArray = array [1..max] of integer;
{отметить вершину как посещённую (заодно присвоить ей номер)} {это эквивалентно} {добавить вершину r к списку в порядке посещения} num[r]:=k; k:=k+1;
for j:=1 to n do begin if (Matrix[r, j]<>0) and (num[j]=0) then begin ftr[j]:=r; dfs(j); end; end; time:=time+1; tk[r]:=time end;
begin clrscr;
writeln('----Поиск в глубину-----'); {$ifdef Debug} {на период отладки матрица смежности и количество вершин графа задаются константами} {$else} write('Введите количество вершин графа:'); readln(n); writeln('Заполнение матрицы смежности'); for i:=1 to n do for j:=1 to n do begin Write('(',i,',',j,')='); read(Matrix[i,j]); if Matrix[i,j] <> 0 then Matrix[i,j]:=1; end; {$endif} //вывод матрицы смежностиж; writeln('Матрица смежности'); for i:=1 to n do begin for j:=1 to n do write(Matrix[i,j],' '); writeln; end; writeln;
//процедура dfs; writeln('Результат dfs'); {инициализация переменных для поиски в глубину (dfs)} for i:=1 to n do begin num[i]:=0; {ни одна вершина не посещалась} ftr[i]:=0; time:=0; k:=1; end; for r:=1 to n do if num[r]=0 then dfs( r );
//вывод массивов num ftr; write('num: '); for i:=1 to n do write(num[i]:3); writeln; write('ftr: '); for i:=1 to n do write(ftr[i]:3); writeln; write('tn: '); for i:=1 to n do write(tn[i]:3); writeln; write('tk: '); for i:=1 to n do write(tk[i]:3); writeln; readln; end.
Estela
19.06.2012 22:56
Your articles are for when it ablsoutley, positively, needs to be understood overnight.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.