Cod sursa(job #1089895)

Utilizator mariusadamMarius Adam mariusadam Data 22 ianuarie 2014 00:42:29
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1 kb
program bfs_infoarena;
var start,v,cd:array[1..100000] of longint;
    viz:array[1..100000] of 0..1;
    bufin,bufout:array[1..1000000] of byte;
    t:array[0..1,1..2000000] of longint;
    i,j,k,nr,s,m,n:longint;
    f,g:text;

procedure bfs(nod:longint);
var pi,ps,z,i:longint;
begin
 viz[nod]:=1;
 pi:=1; ps:=1;
 cd[ps]:=nod;
 while ps<=pi do
  begin
   z:=start[cd[ps]];
   while z<>0 do
    begin
     if viz[t[0,z]]=0 then
      begin
       pi:=pi+1;
       cd[pi]:=t[0,z];
       viz[cd[pi]]:=1;
       v[cd[pi]]:=v[cd[ps]]+1;
      end;
     z:=t[1,z];
    end;
   ps:=ps+1;
  end;
end;

begin
 assign(f,'bfs.in'); reset(f);
 assign(g,'bfs.out'); rewrite(g);
 SetTextBuf(f,bufin);
 SetTextBuf(g,bufout);
 readln(f,n,m,s);
 for nr:=1 to m do
  begin
   readln(f,i,j);
   k:=k+1;
   t[0,k]:=j;
   t[1,k]:=start[i];
   start[i]:=k;
  end;
 bfs(s);
 for nr:=1 to n do
  if (viz[nr]=1) then
   write(g,v[nr],' ')
  else
   write(g,-1,' ');
 close(f);
 close(g);
end.