Cod sursa(job #404536)

Utilizator ioanacosteaIoana Costea ioanacostea Data 26 februarie 2010 11:58:34
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.71 kb
uses crt;
 var a:array[1..100000,1..100000]of longint;
 x,y,i,j,s,p,n,m:longint;
 d:array[1..10000]of longint;
 f:text;
 ok:boolean;
begin
assign(f,'bfs.in');reset(f);
read(f,n,m,s);
for i:=1 to n do a[i,0]:=0;
for i:=1 to m do
 begin
  read(f,x,y);
  inc(a[x,0]);
  a[x,a[x,0]]:=y;
 end;
for i:=1 to n do
  d[i]:=-1;
d[s]:=0;
p:=1;
  for j:=1 to a[s,0] do
      if d[a[s,j]]=-1 then d[a[s,j]]:=p;
 repeat
  ok:=true;
  for i:=1 to n do
    if d[i]=p then
       begin
         s:=i;
         for j:=1 to a[s,0] do if d[a[s,j]]=-1 then begin d[a[s,j]]:=p+1;ok:=false; end;
       end;
   inc(p);
  until ok;
assign(f,'bfs.out');
rewrite(f);
for i:=1 to n do write(f,d[i],' ');
close(f);

end.