Cod sursa(job #854051)

Utilizator chimistuFMI Stirb Andrei chimistu Data 12 ianuarie 2013 18:21:40
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.73 kb
var a:array[1..2,1..1000000] of longint;
b:array[1..100000] of longint;
i,m,n,s:longint;
f,g:text;
ok:boolean;
begin
        assign (f,'bfs.in');assign (g,'bfs.out');
        reset(f);rewrite (g);
        read (f,n,m,s);
        for i:=1 to m do
                read (f,a[1,i], a[2,i]);
        b[s]:=1;
        ok:=true;
        while ok do begin
                ok:=false;
                for i:=1 to m do
                        if (b[a[1,i]]<>0) and ( (b[a[2,i]]=0) or (b[a[2,i]]>b[a[1,i]]+1)) then
                          begin      b[a[2,i]]:=b[a[1,i]]+1;
                                ok:=true;end;
                end;
        for i:=1 to n do
                write (g,b[i]-1,' ');
                close(g);
end.