Cod sursa(job #728130)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 28 martie 2012 15:11:52
Problema BFS - Parcurgere in latime Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.66 kb
Program p1;
type lista=^celula;
     celula=record
             info:longint;
             next:lista;
             end;
var fi,fo : text;
    i,n,m,s,x,y,i_c,s_f,k :longint;
    a:array[0..100001] of lista;
    b,c,d:array[0..1000001] of longint;
    p:lista;

begin
    assign(fi,'bfs.in'); reset(fi); readln(fi,n,m,s);
    assign(fo,'bfs.out'); rewrite(fo);
    for i:=1 to n do begin
                     a[i]:=nil; b[i]:=0;
                     c[i]:=0; d[i]:=-1;
                     end;

    for i:=1 to m do begin
                     readln(fi,x,y);
                     new(p); p^.info:=y;
                     p^.next:=a[x]; a[x]:=p;
                     end;

    c[1]:=s; b[s]:=1; k:=0; d[s]:=0;
    i_c:=1; s_f:=1;
    while i_c<=s_f do begin
                    if b[a[c[i_c]]^.info]=0 then  k:=k+1;
                      while a[c[i_c]]<>nil do  begin
                                            if (b[a[c[i_c]]^.info]=0)  then begin
                                                                         s_f:=s_f+1;
                                                                         c[s_f]:=a[c[i_c]]^.info;
                                                                         b[a[c[i_c]]^.info]:=1;
                                                                         d[c[s_f]]:=k;
                                                                         end;
                                                a[c[i_c]]:=a[c[i_c]]^.next;
                                                end;
                      i_c:=i_c+1;
                      end;
    for i:=1 to n do write(fo,d[i],' ');
    close(fi); close(fo);
end.