Cod sursa(job #280267)

Utilizator batracorina dijmarescu batra Data 13 martie 2009 12:06:51
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.79 kb
const nmax=10000;
var f,g:text;
a:array[1..nmax,0..100] of longint;
viz,c:array[1..nmax]of longint;
x,y,i,m,n,s:longint;
procedure bf(s:longint);
var pc,uc,l,x:longint;
begin
  viz[s]:=1;
  pc:=1;
  uc:=1;
  c[1]:=s;
  while pc<=uc do
     begin
        x:=c[pc];
        l:=viz[x];
        for i:=1 to a[x,0] do
             if viz[a[x,i]]=0 then
                begin
                  uc:=uc+1;
                  viz[a[x,i]]:=l+1;
                  c[uc]:=a[x,i];
                end;
      pc:=pc+1;
      end;
end;
begin
assign(f,'bfs.in');
reset(f);
assign(g,'bfs.out');
rewrite(g);
readln(f,n,m,s);
for i:=1 to m do
   begin
   readln(f,x,y);
   a[x,0]:=a[x,0]+1;
   a[x,a[x,0]]:=y;
   end;
bf(s);
for i:=1 to n do
   write(g,viz[i]-1,' ');
close(g);
end.