Cod sursa(job #869674)

Utilizator andrei_toaderToader Andrei Sorin andrei_toader Data 1 februarie 2013 22:40:22
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
program bfs;
var f,g:text;
    n,m,i:longint;
    a:array of array of longint;
    viz:array[1..100000] of 0..1;
    c:array[1..100000] of longint;
    d:array[1..100000] of longint;
    x,y,ps,pi,s: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,s);
 setlength (a,n+1,1);
 for i:=1 to m do
 begin
   readln (f,x,y);
   setlength (a[x],length(a[x])+1);
   inc(a[x,0]);
   a[x,a[x,0]]:=y;
 end;
  ps:=0; pi:=1; c[1]:=s; viz[s]:=1;
  while ps<pi do
  begin
   inc(ps);
   for i:=1 to a[c[ps],0] do
    if viz[a[c[ps],i]]=0 then
    begin
     viz[a[c[ps],i]]:=1;
     inc(pi);
     c[pi]:=a[c[ps],i];
     d[c[pi]]:=d[c[ps]]+1;
    end;
  end;
  for i:=1 to n do
   if (d[i]=0) and (i<>s) then
    write (g,-1,' ')
   else
    write (g,d[i],' ');
   close (f); close (g);
end.