Cod sursa(job #670377)

Utilizator pongraczlajosLajos Pongracz pongraczlajos Data 28 ianuarie 2012 22:51:57
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.09 kb
type lista=^pont;
     pont=record
      cs:longint;
      kov:lista;
     end;
     xpont=record
      cs,t:longint;
     end;

var a:array[1..50001] of lista;
    tav:array[1..50001] of longint;
    x:array[1..50001] of xpont;
    n,m,i,eleje,vege,kezd:longint;
    p:lista;
    f:text;

procedure betesz(var s:lista; cs:longint);
var uj:lista;
begin
 new(uj);
 uj^.cs:=cs;
 if s=nil then begin
  uj^.kov:=nil;
  s:=uj;
 end
 else begin
  uj^.kov:=s;
  s:=uj;
 end;
end;

begin
assign(f,'bfs.in');
reset(f);
readln(f,n,m,kezd);
for i:=1 to m do begin
 readln(f,eleje,vege);
 if (eleje<>vege) then betesz(a[eleje],vege);
end;
close(f);

for i:=1 to n do
 tav[i]:=-1;
x[1].cs:=kezd;
x[1].t:=0;
eleje:=1;
vege:=1;
while eleje<=vege do begin
 p:=a[x[eleje].cs];
 while p<>nil do begin
  if p^.cs<>kezd then begin
   inc(vege);
   x[vege].cs:=p^.cs;
   x[vege].t:=x[eleje].t+1;
   tav[p^.cs]:=x[vege].t;
  end;
  p:=p^.kov;
 end;
 inc(eleje);
end;
tav[kezd]:=0;

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