Cod sursa(job #1379833)

Utilizator George97George Linut George97 Data 6 martie 2015 19:45:57
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.95 kb
type ref=^adresa;
     adresa=record
     nr:longint;
     urm:ref;
     end;
var a:array[0..1000001] of ref;
    i,j,k,l,ps,pi,n,m,s,x,y:longint;
    f,g:text;
    pp:ref;
    viz,b:array[0..100001] of longint;

begin
assign(f,'bfs.in');
reset(f);
assign(g,'bfs.out');
rewrite(g);
read(f,n,m,s);
for i:=1 to n do
  a[i]:=nil;
for i:=1 to m do
  begin
  read(f,x,y);
  if a[x]=nil then
    begin
    new(a[x]);
    a[x]^.nr:=y;
    a[x]^.urm:=nil;
    end
              else
    begin
    new(pp);
    pp^.nr:=y;
    pp^.urm:=a[x];
    a[x]:=pp;
    end;
  end;
pi:=1;
ps:=1;
for i:=1 to n do
 viz[i]:=-1;
b[1]:=s;
viz[s]:=0;

while ps<=pi do
  begin
  pp:=a[b[ps]];
  while pp<>nil do
    begin
    if viz[pp^.nr]=-1 then
      begin
      inc(pi);
      b[pi]:=pp^.nr;
      viz[pp^.nr]:=viz[b[ps]]+1;
      end;
    pp:=pp^.urm;
    end;
  inc(ps);
  end;
for i:=1 to n do
write(g,viz[i],' ');

close(g);
end.