Cod sursa(job #1339219)

Utilizator ioanacosteaIoana Costea ioanacostea Data 10 februarie 2015 19:26:06
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.13 kb
type
 adresa=^element;
 element=record
     nr:longint;
     urm:adresa;
     end;
var a:array[0..1000001] of adresa;
    f:text;
    ok:boolean;    pp:adresa;
    p,i,j,n,m,s,k:longint;
    v,b,c:array[0..100001]of longint;
    x,y:longint;
begin
assign(f,'bfs.in');reset(f);
readln(f,n,m,s);
for i:=1 to n do a[i]:=nil;
for i:=1 to m do
 begin
    read(f,x,y);
    if a[x]=nil then begin
       new(a[x]);a[x]^.nr:=y;
       a[x]^.urm:=nil;
       end
       else
       begin
        new(pp);pp^.nr:=y;
        pp^.urm:=a[x];a[x]:=pp;
    end;
  {  l1[i]:=-1;}
 end;
for i:=1 to n do v[i]:=-1;
 close(f);
i:=1;
p:=1;
b[1]:=s;
c[1]:=0;
v[s]:=0;
while i<=p do
  begin
    x:=b[i];
    if a[x]<>nil then
    begin
    {
    for j:=l1[x] to l2[x] do}
    pp:=a[x];
    while pp<>nil do
    begin
      if (v[pp^.nr]=-1)  then
       begin
         inc(p);
         b[p]:=pp^.nr;
         c[p]:=c[i]+1;
         v[pp^.nr]:=c[p];
       end;
       pp:=pp^.urm;
       end;
      end;
     inc(i);
    end  ;

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