Cod sursa(job #1413252)

Utilizator Stefan.Andras Stefan Stefan. Data 1 aprilie 2015 19:13:58
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
program repet2;
const varfmax = 100001;
      muchiimax = 1000000;
var f,g:text;
    n,m,s,i,k,j:longint;
    viz,coada,start:array[1..varfmax] of longint;
    t:array[0..1,1..muchiimax] of longint;
    bufin,bufout:array[1..1 shl 17] of char;
procedure bfs(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);
        settextbuf(f,bufin); 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;
        bfs(s);
        for i := 1 to n do
                write(g,viz[i] - 1,' ');
        close(f); close(g);
end.