Cod sursa(job #1168906)

Utilizator DjokValeriu Motroi Djok Data 9 aprilie 2014 21:17:37
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.3 kb
type list=^cell;
     cell=record
      info:longint;
      pred:list;
     end;

var lda:array[1..100010] of list;
    rs,q:array[1..100010] of longint;
    viz:array[1..100010] of byte;
    n,m,s,i,head,tail:longint;
    r:list;
    bif,bof:array[1..1 shl 16] of char;

  procedure add(v:longint; var r:list);
   var p:list;
    begin
     new(p);
     p^.info:=v;
     p^.pred:=r;
     r:=p;
    end;

begin
 assign(input,'bfs.in');
 assign(output,'bfs.out');
 reset(input);
 rewrite(output);
 settextbuf(input,bif);
 settextbuf(output,bof);

  readln(n,m,s);
   for i:=1 to m do
    begin
     readln(head,tail);
     add(tail,lda[head]);
    end;
   for i:=1 to n do
    rs[i]:=-1;

  q[1]:=s; head:=1; tail:=1; rs[s]:=0; viz[s]:=1;

   while head<=tail do
    begin
     r:=lda[q[head]];
      while r<>nil do
       begin
        if viz[r^.info]=0 then begin
                                inc(tail);
                                q[tail]:=r^.info;
                                rs[q[tail]]:=rs[q[head]]+1;
                                viz[r^.info]:=1;
                               end;
        r:=r^.pred;
       end;
     inc(head);
    end;

   for i:=1 to n do
    write(rs[i],' ');

 close(input);
 close(output);
{Totusi este trist in lume}
end.