Cod sursa(job #747202)

Utilizator andrei_toaderToader Andrei Sorin andrei_toader Data 11 mai 2012 19:07:40
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
program kakamaka;
var f,g:text;
    n,m,nod,i,x,y,ps,pi:longint;
    a:array of array of longint;
    cd:array [1..100000] of longint;
    viz:array[1..100000] of 0..1;
    d:array [1..100000] of longint;
    bufin,bufout:array[1..65000] of byte;

begin
 assign (f,'bfs.in'); reset (f);
 assign (g,'bfs.out'); rewrite (g);
 settextbuf (f,bufin);
 settextbuf (g,bufout);
 readln (f,n,m,nod);
 setlength (a,n+1,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;
 ps:=0; pi:=1; cd[1]:=nod; viz[nod]:=1;
 while ps<pi do
 begin
  ps:=ps+1;
  for i:=1 to a[cd[ps],0] do
   if viz[a[cd[ps],i]]=0 then
   begin
    pi:=pi+1;
    cd[pi]:=a[cd[ps],i];
    viz[a[cd[ps],i]]:=1;
    d[a[cd[ps],i]]:=d[cd[ps]]+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.