Cod sursa(job #551430)

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

var v:array [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);

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

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

p:=v[s];
k:=1; kk:=1;
t[1]:=s; chk[s]:=1;
while k <=kk do
  begin
  p:=v[t[k]];
  for i := 1 to v[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.