Cod sursa(job #1359896)

Utilizator batman1234Jugariu Mihai batman1234 Data 25 februarie 2015 09:28:00
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 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;

 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];
    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;

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