Cod sursa(job #1346605)

Utilizator mihai1996Toader Mihai mihai1996 Data 18 februarie 2015 13:59:45
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.1 kb
program bfs;
var f,g:text;
    start,d,viz,cd:array[1..100000] of longint;
    t:array[0..1,1..2000000] of longint;
    i,j,k,x,y,s,n,m:longint;
    bufin,bufout:array[1..1000000] of byte;

procedure bf(nod:longint);
var st,sf,p:longint;
begin
  viz[nod]:=1;
  cd[1]:=nod;
  st:=1;
  sf:=1;
  d[nod]:=0;
  while st<=sf do
    begin
      p:=start[cd[st]];
      while p<>0 do
        begin
          if viz[t[0,p]]=0 then
            begin
              inc(sf);
              cd[sf]:=t[0,p];
              viz[t[0,p]]:=1;
              d[t[0,p]]:=d[cd[st]]+1;
            end;
          p:=t[1,p];
        end;
      inc(st);
    end;
end;

begin
  assign(f,'bfs.in'); reset(f);
  assign(g,'bfs.out'); rewrite(g);
  settextbuff(f,bufin);
  settextbuff(g,bufout);
  readln(f,n,m,s);
  k:=0;
  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;
  bf(s);
  for i:=1 to n do
    if viz[i]=1 then
      write(g,d[i],' ')
       else
      write(g,-1,' ');
  writeln(g);
  close(f); close(g);
end.