Cod sursa(job #1359925)

Utilizator George97George Linut George97 Data 25 februarie 2015 09:47:09
Problema BFS - Parcurgere in latime Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 0.65 kb
var a:array[1..5000,1..5000] of longint;
    i,j,k,l,n,m,x,y,ps,pi:longint;
    viz,pred,b:array[1..100000] of longint;
    f,g:text;

begin
assign(f,'bfs.in');
reset(f);
assign(g,'bfs.out');
rewrite(g);
read(f,n,m,k);
for i:=1 to m do
  begin
  read(f,x,y);
  a[x,y]:=1;
  end;
ps:=1;
pi:=1;
for i:=1 to n do
  viz[i]:=-1;
viz[k]:=0;
pred[1]:=0;
b[1]:=k;
 while ps<=pi do
   begin
   for i:=1 to n do
     if (a[b[ps],i]=1) and (viz[i]=-1) then
       begin
       inc(pi);
       pred[pi]:=ps;
       b[pi]:=i;
       viz[i]:=pred[ps]+1;
       end;
   inc(ps);
   end;
for i:=1 to n do
  write(g,viz[i],' ');
close(g);
end.