Cod sursa(job #1339109)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 10 februarie 2015 18:03:52
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.84 kb
program numarare;
var     t:array[0..1,1..2000000] of longint;
        c,viz,start:array[1..100000] of longint;
        f,g:text;
        st,sf,z,s,n,m,x,y,i,j,k:longint;
begin
  assign(f,'bfs.in'); reset(f);
  assign(g,'bfs.out'); rewrite(g);
  readln(f,n,m,s);
  inc(k);
  for i:=1 to m do
    begin
      readln(f,x,y);
      inc(k);
      t[0,k]:=y;
      t[1,k]:=start[x];
      start[x]:=k;
    end;
  st:=1; sf:=1; viz[s]:=1; c[st]:=s;
  while st<=sf do
    begin
      k:=start[c[st]];
      while k<>0 do
        if viz[t[0,k]]=0 then
          begin
            inc(sf);
            c[sf]:=t[0,k];
            viz[c[sf]]:=viz[c[st]]+1;
            k:=t[1,k];
          end
        else k:=t[1,k];
      inc(st);
    end;
  for i:=1 to n do
    begin
      write(g,viz[i]-1,' ');
    end;
  close(g); close(f);
end.