Cod sursa(job #1359921)

Utilizator Stefan.Andras Stefan Stefan. Data 25 februarie 2015 09:45:15
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
program liste_adiacenta;
type lista = array[0..1,1..1000000] of longint;
type pornire = array[1..100000] of longint;
var f,g:text;
    start:pornire;
    t:lista;
    n,m,s,i,j,k:longint;
    coada:array[1..100000] of longint;
    viz:array[1..100000] of longint;
    bufin,bufout:array[1..1000001] of byte;
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   //cat timp am noduri adiacente
                        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);     settextbuf(f,bufin);
        assign(g,'bfs.out'); rewrite(g);  settextbuf(f,bufout);
        readln(f,n,m,s);
        for k:=1 to m do
                begin
                readln(f,i,j);
                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.