Cod sursa(job #246988)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 21 ianuarie 2009 22:47:35
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.67 kb
var f,g:text;
viz,c:array[1..100000] of longint;
a:array[1..50000,0..10000] of integer;
j,l,u,m,s,n,i,p,uc,x,y,pc:longint;
begin
assign(f,'bfs.in');
reset(f);
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;
for i:=1 to n do
viz[i]:=-1;
pc:=1;
uc:=1;
c[pc]:=s;
viz[s]:=0;
while pc<=uc do
 begin
   x:=c[pc];
   l:=viz[x];
   for i:=1 to a[x,0] do
         if (viz[a[x,i]]=-1) then
            begin
            uc:=uc+1;
            c[uc]:=a[x,i];
            viz[a[x,i]]:=l+1;
          end;
   pc:=pc+1;
 end;
assign(g,'bfs.out');
rewrite(g);
for i:=1 to n do
write(g,viz[i],' ');
close(g);
end.