Cod sursa(job #551574)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 10 martie 2011 21:19:12
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.01 kb
type muchie=^nod;
     nod = record n:longint; a:muchie; end;

var v:array [1..2, 1..100000] of muchie;
    t:array [1..100000] of longint;
    chk:array[1..100000] of longint;
    buf1:array[1..1000000] of char;
    x, y, i, j, m, n, k, kk, s:longint;
    p, r:muchie;
    f, g:text;

begin
assign (f, 'bfs.in'); settextbuf (f, buf1); reset (f);
assign (g, 'bfs.out'); rewrite (g);

read (f, n, m, s);
for i := 1 to n do begin new (v[1, i]); v[1, i]^.n:=0; end;

for i := 1 to m do
  begin
  read (f, x, y);
  p:=v[1, x];
  if p^.n <> 0 then p:=v[2, x];
  new (r); r^.n:=y; p^.a:=r; v[2, x] :=r;
  v[1, x]^.n:=v[1, x]^.n+1;
  end;

p:=v[1, s];
k:=1; kk:=1;
t[1]:=s; chk[s]:=1;
while k <=kk do
  begin
  p:=v[1, t[k]];
  for i := 1 to v[1, t[k]]^.n do
    begin
    p:=p^.a;
    if chk[p^.n] = 0 then
      begin
      chk[p^.n]:=chk[t[k]]+1;
      kk:=kk+1;
      t[kk]:=p^.n;
      end;
    end;
  k:=k+1;
  end;

for i := 1 to n do write (g, chk[i]-1, ' ');
close (f); close (g);
end.