Cod sursa(job #1603913)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 17 februarie 2016 20:28:39
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.06 kb
program mire;
var f,g:text;
    n,m,s,i:longint;
    a:array[0..1,0..2000000] of longint;
    co,viz,start:array[0..2000000] of longint;
    bufin,bufout:array[1..1 shl 16] of byte;
procedure citire;
var i,x,y,k:longint;
begin
  assign(f,'bfs.in'); reset(f);
  assign(g,'bfs.out'); rewrite(g);
 settextbuf(f,bufin); settextbuf(g,bufout);
    readln(f,n,m,s);
    k:=0;
    for i:=1 to m do
      begin
         readln(f,x,y);
         inc(k);
         a[0,k]:=y;
         a[1,k]:=start[x];
         start[x]:=k;
      end;
  close(f);
end;
procedure bfs(nod:longint);
var p,st,sf:longint;
begin
  viz[nod]:=1; st:=1; sf:=1; co[st]:=nod;
  while st<=sf do
    begin
      p:=start[co[st]];
      while p<>0 do
        begin
          if viz[a[0,p]]=0 then
            begin
              inc(sf);
              co[sf]:=a[0,p];
              viz[a[0,p]]:=viz[co[st]]+1;
            end;
           p:=a[1,p];
        end;
       inc(st);
    end;

end;
begin
  citire;
  bfs(s);
  for i:=1 to n do
    write(g,viz[i]-1,' ');
  close(g);
end.