Cod sursa(job #1581322)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 26 ianuarie 2016 18:56:45
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
program bfs;
var f,g:text;
    t1,t2,start,co,viz:array of longint;
    i,n,s,m,k,l,z,j,st,dr:longint;
    bufin,bufout:array[1..1 shl 17] of char;
begin
  assign(f,'bfs.in');reset(f);
  assign(g,'bfs.out');rewrite(g);
  settextbuf(f,bufin); settextbuf(f,bufout);
  readln(f,n,m,s);
  setlength(start,n+1);
  setlength(t1,2*m+1);
  setlength(t2,2*m+1);
  setlength(co,n+1);
  setlength(viz,n+1);
  k:=0;
  for k:=1 to m do
    begin
      readln(f,i,j);
      t1[k]:=j;
      t2[k]:=start[i];
      start[i]:=k;
    end;
  st:=1;
  dr:=1;
  co[st]:=s;
  viz[s]:=1;
  while st<=dr+1 do
    begin
      z:=start[co[st]];
      while z<>0 do
        begin
          if viz[t1[z]]=0 then
            begin
              inc(dr);
              co[dr]:=t1[z];
              viz[t1[z]]:=viz[co[st]]+1;
            end;
          z:=t2[z];
        end;
      inc(st);
    end;
  for i:=1 to n do
    write(g,viz[i]-1,' ');
  close(f);
  close(g);
end.