Cod sursa(job #403797)

Utilizator mimarcelMoldovan Marcel mimarcel Data 25 februarie 2010 12:19:51
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.11 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,r:longint;
    l:liste;
    viz:vector;
    pi,ps,p,q: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);
new(pi);
pi^.nod:=s;
pi^.urm:=nil;
ps:=pi;
viz[s]:=0;
while ps<>nil do
  begin
  x:=ps^.nod;
  r:=viz[x]+1;
  p:=l[x];
  while p<>nil do
    begin
    y:=p^.nod;
    if viz[y]=-1 then begin
                      new(q);
                      q^.nod:=y;
                      q^.urm:=nil;
                      pi^.urm:=q;
                      pi:=q;
                      viz[y]:=r;
                      end;
    p:=p^.urm;
    end;
  p:=ps;
  ps:=ps^.urm;
  dispose(p);
  end;

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