Версия для печати темы

Автор: Bo2nik 4.06.2008 19:55

Проблема с процедурой BFS(обход в ширину), не получается вывести нормальный путь или процедура корявая. Смотрел в FAQ - не помогло. Граф задан матрицой смежности. Вводится вершина из которой начинается обход.

Содержимое файла:
6
0 1 0 1 0 0
1 0 1 0 0 0
0 1 0 1 1 0
1 0 1 0 1 1
0 0 1 1 0 1
0 0 0 1 1 0

Например ввожу n=2:
DFS 2 - 1 - 4 - 3 - 5 - 6 - 5 - 3 - 4 - 1 - 2
BFS 2 - 1

Program workgraph;
uses crt;
const max=30;
      max2=10000;

type graph = array [1..max,1..max] of integer;

var a,ras: graph;
    size,n,j,i: integer;

Procedure ReadFile;
var i,j: integer;
    f: text;
begin
     assign(f,'D:\floyd2.txt');
     reset(f);
     readln(f,size);
     for i:=1 to size do
         for j:=1 to size do
         begin
              read(f,ras[i,j]);
              if (ras[i,j]=0) and (i<>j) then
                 ras[i,j]:=max2;
         end;
     close(f);
end;

Procedure Print(a: graph);
var i,j: integer;
begin
     for i:=1 to size do
     begin
          for j:=1 to size do
          if a[i,j]=max2 then
             write(' **')
          else
              write(a[i,j]:3);
          writeln;
     end;
end;

Procedure DFS(a: graph; n: integer);
var go: array[1..max] of boolean;
    j: integer;

 Procedure DFS2(n: integer);
 var i :integer;
 begin
      write (' - ',n);
      go[n]:=false;
      for i:=1 to size do
          if (go[i]) and (a[n,i]<>max2) and (i<>n) then
          begin
               DFS2(i);
               write (' - ',n);
          end;
 end;

begin
     for j:=1 to n do
         go[j]:=true;
     write ('DFS');
     DFS2(n);
     writeln;
end;

Procedure BFS(a: graph; n: integer);
var go: array[1..max] of boolean;
    i: integer;

 Procedure BFS2(n: integer);
 var og: array[1..max] of 0..max;
     u1,u2: integer;
     j: integer;
 begin
      FillChar(og,sizeof(og),0);
      u2:=0; u1:=1;
      og[u1]:=n;
      go[n]:=false;
      while u2<u1 do
      begin
           inc(u2);
           n:=og[u2];
           write(n:2);
           for j:=1 to size do
               if (a[n,j]<>max2) and (go[j]) then
               begin
                    inc(u1);
                    og[u1]:=j;
                    go[j]:=false;
               end;
      end;
 end;

begin
     for i:=1 to n do
         go[i]:=true;
     BFS2(n);
     writeln;
end;

begin
     clrscr;
     ReadFile;
     writeln('Matrix of weight: ');
     Print(ras);
     writeln;
     write('Dlya kakoy vershini provesti DFS: ');
     readln(n);
     DFS(ras,n);
     write('Dlya kakoy vershini provesti BFS: ');
     readln(n);
     BFS(ras,n);
     readln;
end.

Автор: volvo 7.06.2008 21:55

Вот так работает:

Procedure BFS(const a: graph; n: integer);
var go: array[1..max] of boolean;
    i: integer;

 Procedure BFS2;
 var
   og: array[1..max] of integer;
   u1,u2: integer;
   j: integer;
 begin
   FillChar(og,sizeof(og),0);
   u2:=0; u1:=1;
   og[u1]:=n;
   go[n]:=false;
   while u2<u1 do begin
     inc(u2);
     n:=og[u2];
     write(n:2);
     for j:=1 to size do
       if (a[n,j]<>max2) and (go[j]) then begin
         inc(u1);
         og[u1]:=j;
         go[j]:=false;
       end;
   end;
 end;

begin
  for i := 1 to max do
    go[i] := true;
  BFS2;
  writeln;
end;

Результат:

Matrix of weight:
  0  1 **  1 ** **
  1  0  1 ** ** **
 **  1  0  1  1 **
  1 **  1  0  1  1
 ** **  1  1  0  1
 ** ** **  1  1  0

Dlya kakoy vershini provesti DFS: 2
DFS - 2 - 1 - 2 - 3 - 5 - 6 - 5 - 3 - 2
Dlya kakoy vershini provesti BFS: 2
 2 1 3 4 5 6