Cod sursa(job #1376502)

Utilizator Stefan.Andras Stefan Stefan. Data 5 martie 2015 17:39:08
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
program repetbfs;
var f,g:text;
    n,m,s,k,x,i,j:longint;
    t:array[0..1,1..1000001] of longint;
    start,viz,coada:array[1..100001] of longint;
procedure bf(nod:longint);
var p,u,z:longint;
begin
   p:=1; u:=1;
   coada[p]:=nod;
   viz[nod]:=1;
   while p <= u do
        begin
        z:=start[coada[p]];
        while z <> 0 do
                begin
                if viz[t[0,z]] = 0 then
                        begin
                        inc(u);
                        coada[u]:=t[0,z];
                        viz[t[0,z]]:=viz[coada[p]]+1;
                        end;
                z:=t[1,z];
                end;
        inc(p);
        end;

end;
begin
        assign(f,'bfs.in'); reset(f);
        assign(g,'bfs.out'); rewrite(g);
        //citire graf orientat
        readln(f,n,m,s);
        for x:=1 to m do
                begin
                readln(f,i,j);
                inc(k);
                t[0,k]:=j;
                t[1,k]:=start[i];
                start[i]:=k;
                end;
        bf(s);
        for i:=1 to n do
                write(g,viz[i]-1,' ');
        close(f); close(g);
end.