Cod sursa(job #386432)

Utilizator arnold23Arnold Tempfli arnold23 Data 24 ianuarie 2010 20:13:40
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.96 kb
type lista=^elem;
     elem=record
       csp:longint;
       kov:lista;
     end;

var f:text;
    v:array[1..100000] of lista;
    szel,dist:array[1..100000] of longint;
    lat:array[1..100000] of boolean;
    n,m,s,a,b,l,cel,i:longint;
    q:lista;

procedure betesz(w,e:longint);
var p:lista;
begin
 new(p);
 p^.csp:=e;
 p^.kov:=v[w];
 v[w]:=p;
end;

begin
 assign(f,'bfs.in');
 reset(f);
 readln(f,n,m,s);
 for i:=1 to m do begin
   readln(f,a,b);
   betesz(a,b);
 end;
 close(f);

 for i:=1 to n do dist[i]:=-1;
 l:=1;
 cel:=1;
 szel[1]:=s;
 dist[s]:=0;
 lat[s]:=true;
 while l<=cel do begin
   q:=v[szel[l]];
   while q<>nil do begin
     if not lat[q^.csp] then begin
       inc(cel);
       szel[cel]:=q^.csp;
       dist[q^.csp]:=dist[szel[l]]+1;
       lat[q^.csp]:=true;
     end;
     q:=q^.kov;
   end;
   inc(l);
 end;

 assign(f,'bfs.out');
 rewrite(f);
 for i:=1 to n do
  write(f,dist[i],' ');
 close(f);

end.