Cod sursa(job #1339224)

Utilizator vergilius_beberindeie virgil vergilius_be Data 10 februarie 2015 19:27:11
Problema BFS - Parcurgere in latime Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 0.85 kb
program numarare;
var h,g:text;
a:array[1..10000,1..10000] of 0..1;
m,p,n,x,y,i,c:longint;
viz:array[1..100000] of integer;

procedure bf(nod:longint);
var st,sf,i:longint;
co:array[1..100000] of longint;
begin
   viz[nod]:=1;
   st:=1;
   sf:=1;
   co[1]:=nod;
   while sf<=st do
   begin
   c:=co[st];
   for i:=1 to n do
      begin
         if (a[c,i]<>0) then
          if  (viz[i]=0) then
           begin
              viz[i]:=viz[c]+1;
              st:=st+1;
              co[st]:=i;
           end;
      end;

     sf:=sf+1;
   end;
   for i:=1 to n do
      write(g,viz[i]-1,' ');
end;

begin
   assign(h,'bfs.in');
   reset(h);
   assign(g,'bfs.out');
   rewrite(g);
   readln(h,n,m,p);
   for i:=1 to m do
      begin
      readln(h,x,y);
      a[x,y]:=1;
      end;
   bf(p);
   close(h);
   close(g);
end.