графы.поиск в глубину Опции

[Юлия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.

Псевдокод кинула по которому написано

Сообщение отредактировано: Юлия92 - 26.04.2012 17:08

[Федосеев Павел]

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

Сообщение отредактировано: Федосеев Павел - 26.04.2012 21:19

[Estela]

Your articles are for when it ablsoutley, positively, needs to be understood overnight.