Cod sursa(job #1093416)

Utilizator Vasile_Catananoname Vasile_Catana Data 27 ianuarie 2014 22:53:04
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
program p1;
type lista=^celula;
      celula= record
        info:longint;
        urm:lista;
                end;
var a:array[0..1000000] of lista;
    F,G:tEXT;
    i,n,j,k,u,i_c,sf_C,s,m,x,y:longint;
    c,d:array[0..1000000] of longint;
    q:lista;
    b1,b2:array[0..1 shl 25] of char;
procedure bfs(k:longint);
var i_c,sf_c:longint;
begin
c[1]:=k;
i_c:=1;
sf_c:=1;
while i_c<=sf_C do begin
        q:=a[c[i_C]];
        while q<> nil do begin
                if d[q^.info]=-1 then begin
                                inc(Sf_C);
                                c[sf_C]:=q^.info;
                                d[c[sf_C]]:=d[c[i_C]]+1;
                                      end;
                          q:=q^.urm;
                    end;
                inc(i_C);
                end;
end;
begin
assign(f,'bfs.in');settextbuf(f,b1);reset(F);
assign(g,'bfs.out');settextbuf(g,b2);rewrite(G);
readln(f,n,m,k);
for i:=1 to n do begin
        d[i]:=-1;
                end;
for i:=1 to m do begin
        readln(f,x,y);
         new(q);
         q^.info:=y;
         q^.urm:=a[x];
         a[x]:=q;
                end;
d[k]:=0;
bfs(K);
for i:=1 to n do write(G,d[i],' ');
close(F);
close(G);
end.