Cod sursa(job #928993)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 19:49:30
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
program bfs; //nr min de arce de la X la alealalte noduri
type vect=array[1..100000] of longint;
     vectbool=array[1..100000] of 0..1;
var a:array of array of longint;
    n,m,i,x,y,ps,pi,s:longint;
    viz:vectbool; d,cd:vect;
    f,g:text;
    intrare,iesire:array[1..300000] of char;

begin
assign(f,'bfs.in'); reset(f);  settextbuf(f,intrare);
assign(g,'bfs.out'); rewrite(g); settextbuf(g,iesire);
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;
cd[1]:=s; d[s]:=0;
viz[s]:=1;
ps:=0; pi:=1;
while ps<pi do
 begin
 inc(ps);
 for i:=1 to a[cd[ps],0] do
   if viz[a[cd[ps],i]]=0 then
     begin
     inc(pi);
     cd[pi]:=a[cd[ps],i];
     viz[cd[pi]]:=1;
     d[cd[pi]]:=d[cd[ps]]+1;
    end;
 end;
for i:=1 to n do
 begin
 if (d[i]=0) and (i<>s) then d[i]:=-1;
 write(g,d[i],' ');
 end;
close(f);close(g);
end.