Cod sursa(job #403796)

Utilizator mimarcelMoldovan Marcel mimarcel Data 25 februarie 2010 12:19:43
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
const maxn=100000;
type plista=^lista;
     lista=record
           nod:longint;
           urm:plista;
           end;
     liste=array[1..maxn]of plista;
     vector=array[1..maxn]of longint;
var n,m,s,i,x,y:longint;
    l:liste;
    c,viz:vector;
    pi,ps,r:longint;
    p:plista;

begin
assign(input,'bfs.in');
reset(input);
assign(output,'bfs.out');
rewrite(output);
readln(n,m,s);

for i:=1 to m do
  begin
  readln(x,y);
  new(p);
  p^.nod:=y;
  p^.urm:=l[x];
  l[x]:=p;
  end;

filldword(viz,sizeof(viz)div sizeof(longint),-1);
pi:=1;
ps:=1;
c[1]:=s;
viz[s]:=0;
while ps<=pi do
  begin
  x:=c[ps];
  r:=viz[x]+1;
  p:=l[x];
  while p<>nil do
    begin
    y:=p^.nod;
    if viz[y]=-1 then begin
                      inc(pi);
                      c[pi]:=y;
                      viz[y]:=r;
                      end;
    p:=p^.urm;
    end;
  inc(ps);
  end;

for i:=1 to n do write(viz[i],' ');
close(output);
close(input);
end.