Cod sursa(job #694712)

Utilizator andrei_toaderToader Andrei Sorin andrei_toader Data 27 februarie 2012 22:59:11
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
program parcurgere;
var f,g:text;
     n,m,i,j,x,y,nod,st,sf:longint;
     a:array of array of longint;
     v,d:array[1..1000000] of longint;
     viz:array [1..1000000] of 0..1;

begin
 assign (f,'bfs.in'); reset (f);
 assign (g,'bfs.out'); rewrite (G);
 readln (f,n,m,nod);
 setlength (a,n+1);
 for i:=1 to n do
  setlength (a[i],1);
 for i:=1 to m do
 begin
   readln (f,x,y);
   setlength (a[x],length (a[x])+1);
   a[x,0]:=a[x,0]+1;
   a[x,a[x,0]]:=y;
 end;
  v[1]:=nod;
  viz[nod]:=1;
  st:=0; sf:=1;
  while st<sf do
  begin
   st:=st+1;
   for i:=1 to a[v[st],0] do
    if viz[a[v[st],i]]=0 then
    begin
     sf:=sf+1;
     viz[a[v[st],i]]:=1;
     v[sf]:=a[v[st],i];
     d[a[v[st],i]]:=d[v[st]]+1;
    end;
  end;
  for i:=1 to n do
  begin
   if (d[i]=0) and (i<>nod) then
    d[i]:=-1;
   write (g,d[i],' ');
  end;
 close (f);
 close  (g);
end.