Cod sursa(job #581157)

Utilizator muskMuscalu Alexandru musk Data 13 aprilie 2011 20:27:43
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.39 kb
var a:array[0..5000,0..5000] of integer;
    i,j,k,n,m,st,dr,s:integer;
    c,use,t:array[1..5000] of integer;
    f,g:text;
procedure citire;
begin
assign(f,'bfs.in');
reset(f);
for i:=1 to n do
 for j:=1 to n do a[i,j]:=0;
read(f,n,m,s);
for k:=1 to m do
    begin
    read(f,i,j);
    a[i,0]:=a[i,0]+1;
    a[i,a[i,0]]:=j;

    end;

close(f);
end;

procedure bf;
begin
for i:=1 to n do use[i]:=0;
for i:=1 to n do t[i]:=-1;
st:=1;
dr:=1;
use[s]:=0;
t[s]:=0;
c[1]:=s;
while st<=dr do
  begin
  k:=c[st];
  for j:=1 to a[k,0] do
      if (use[a[k,j]]=0) then
                     begin
                     dr:=dr+1;
                     c[dr]:=a[k,j];
                     use[a[k,j]]:=1;
                     t[a[k,j]]:=t[k]+1;
                     end;
  st:=st+1;
  end;
end;




begin
citire;
k:=0;
for i:=1 to n do use[i]:=0;
for i:=1 to n do t[i]:=-1;
st:=1;
dr:=1;
use[s]:=1;
t[s]:=0;
c[1]:=s;
while st<=dr do
  begin
  k:=c[st];                                 f
  for j:=1 to a[k,0] do
      if (use[a[k,j]]=0) then
                     begin
                     dr:=dr+1;
                     c[dr]:=a[k,j];
                     use[a[k,j]]:=1;
                     t[a[k,j]]:=t[k]+1;
                     end;
  st:=st+1;
  end;
assign(g,'bfs.out');rewrite(g);
for i:=1 to n do
        write(g,t[i],' '); writeln;
close(g);


end.