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

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.


Псевдокод кинула по которому написано
Федосеев Павел
Будь внимательнее, ведь там всё просто. Результат обхода графа - список вершин в порядке их посещения. Если вершинам присваивать номера во время обхода, получим тот же искомый список.
Здесь в 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;

var
i,j,
r,time,k : integer;
num, {номер вершины=порядок обхода графа=признак посещённости}
ftr : TArray;
tn,tk:TArray;
const
{$ifdef Debug}
{ 1 2 3 4 5 6 7 }
Matrix : TMatrix = ( {матрица смежности}
(0,1,0,1,1,0,0),
(0,0,1,0,1,0,0),
(0,0,0,0,0,0,0),
(0,0,0,0,1,0,0),
(0,0,0,0,0,0,0),
(0,1,1,0,1,0,1),
(0,0,0,0,1,0,0)
);
n : integer = 7; {количество вершин графа}
{$else}
Matrix : TMatrix; {матрица смежности}
n : integer; {количество вершин графа}
{$endif}

procedure dfs(r:integer);
var
j:integer;

begin
time:=time+1;
tn[r]:=time;

writeln(r:4);

{отметить вершину как посещённую (заодно присвоить ей номер)}
{это эквивалентно}
{добавить вершину 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
Your articles are for when it ablsoutley, positively, needs to be understood overnight.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.