Cod sursa(job #1581354)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 26 ianuarie 2016 19:19:24
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 kb
program bfs;
var f,g:text;
    t1,t2,start,co,viz:array of longint;
    n,s,m:longint;
    bufin,bufout:array[1..1 shl 17] of char;
  procedure citire;
  var k,i,j:longint;
  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);
    for k:=1 to m do
      begin
        readln(f,i,j);
        t1[k]:=j;
        t2[k]:=start[i];
        start[i]:=k;
      end;
    close(f);
  end;
  procedure afisare;
  var i:longint;
  begin
  for i:=1 to n do
    write(g,viz[i]-1,' ');
  close(g);
  end;
  procedure bf(nod:longint);
  var st,dr,z:longint;
  begin
  st:=1;
  dr:=1;
  co[st]:=nod;
  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;
  end;
begin
  citire;
  bf(s);
  afisare;
end.