Cod sursa(job #247631)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 23 ianuarie 2009 15:35:57
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 kb
type lista=^elem;
   elem=record
          v:longint;
          adu:lista;
          end;
var f,g:text;
l:array[1..100000] of lista;
viz,c:array[1..100000] of longint;
m,ordin,s,n,i,uc,x,y,pc:longint;
p,q:lista;
begin
assign(f,'bfs.in');
reset(f);
readln(f,n,m,s);
for i:=1 to m do
  begin
  readln(f,x,y);
  new(q);
  q^.v:=y;
  if l[x]=nil then begin
                   q^.adu:=nil;
                   l[x]:=q;
                   end
                   else
                   begin
                   q^.adu:=l[x];
                   l[x]:=q;
                   end;
  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];
   p:=l[x];
   ordin:=viz[x];
   while p<>nil do begin
       if (viz[p^.v]=-1) then
            begin
            uc:=uc+1;
            c[uc]:=p^.v;
            viz[p^.v]:=ordin+1;
            end;
          p:=p^.adu;
          end;
   pc:=pc+1;
 end;
assign(g,'bfs.out');
rewrite(g);
for i:=1 to n do
write(g,viz[i],' ');
close(g);
end.