Cod sursa(job #1339218)

Utilizator vergilius_beberindeie virgil vergilius_be Data 10 februarie 2015 19:25:41
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.92 kb
program asa;
var f,g:text;
    n,m,s,i,j,x,y:longint;
    a:array[1..4000,1..4000] of byte;
    viz:array[1..4000] of integer;
    c:array[1..4000] of integer;
procedure bf(nod:longint);
var u,p:longint;
begin
   for i:=1 to n do
      viz[i]:=0;
   p:=1; u:=1;
   viz[nod]:=1;
   c[p]:=nod;
   while p <= u do
      begin
      for i:=1 to n do
         if (a[c[p],i] = 1) and (viz[i] = 0) then
            begin
            inc(u);
            viz[i]:=viz[c[p]]+1;
            c[u]:=i;
            end;
      inc(p);
      end;

end;
begin
   assign(f,'bfs.in'); reset(f);
   assign(g,'bfs.out'); rewrite(g);
   readln(f,n,m,s);
   for i:=1 to m do
      begin
      readln(f,x,y);
      a[x,y]:=1;
      end;
   //parcurg fiecare nod la care trebuie sa ajung
   bf(s);
   for i:=1 to n do
      write(g,viz[i]-1,' ');   // - 1 deoarece plec de la 1 .. 1 = vizitat.
   close(f); close(g);
end.