Cod sursa(job #1166879)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 3 aprilie 2014 21:54:14
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.06 kb
program bfs;
const nmax=100005;
 type lista=^celula;
    celula=record
       info:longint;
       pred:lista;
       end;
    var a:array[1..nmax] of lista;
        c,d,viz:array[1..nmax] of longint;
        r:lista;
        n,m,s,p,u,i,j,x,y:longint;
    begin
      assign(input,'bfs.in');
      reset(input);
      assign(output,'bfs.out');
      rewrite(output);

      readln(n,m,s);
      for i:=1 to m do begin
        readln(x,y);
        new(r);
        r^.info:=y;
        r^.pred:=a[x];
        a[x]:=r;
        end;
      for i:=1 to n do d[i]:=-1;

      p:=1;
      u:=1;
      c[1]:=s;
      d[s]:=0;
      viz[c[1]]:=1;
      while p<=u do begin
        r:=a[c[p]];
        while r<>nil do begin
           if viz[r^.info]=0 then
             begin
               viz[r^.info]:=1;
               u:=u+1;
               c[u]:=r^.info;
               d[c[u]]:=d[c[p]]+1;
             end;
           r:=r^.pred;
           end;
        p:=p+1;
        end;
    for i:=1 to n do write(d[i],' ');
    close(output);
 end.