Cod sursa(job #284653)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 21 martie 2009 21:06:58
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
type pnod=^nd;
     nd=record
         info:longint;
         urm:pnod;
         end;
var v:array[1..10000]of pnod;
    d:array[1..10000]of longint;
    i,x,y,n,m,s:longint;
    f,g:text;

procedure init(var p:pnod;x:longint);
var q:pnod;
begin
new(q);
q^.info:=x;
if p=nil then begin
              q^.urm:=nil;
              p:=q;
              end
              else begin
                   q^.urm:=p;
                   p:=q;
                   end;
end;

procedure bfs;
var c:array[1..10000]of longint;
    p,u,nod:longint;
    q:pnod;
begin
p:=1; u:=1;
c[p]:=s; d[s]:=0;
while p<=u do begin
      nod:=c[p]; q:=v[nod];
      while q<>nil do begin
            if (d[q^.info]=0)and(q^.info<>s) then begin
                             d[q^.info]:=d[nod]+1;
                             inc(u);
                             c[u]:=q^.info;
                             end;
            q:=q^.urm;
            end;
      inc(p);
      end;
end;

begin
assign(f,'bfs.in');reset(f);
assign(g,'bfs.out');rewrite(g);
read(f,n,m,s);
for i:=1 to m do begin
    read(f,x,y);
    init(v[x],y);
    end;
bfs;
for i:=1 to n do if (d[i]=0)and(i<>s)then write(g,-1,' ')
                    else write(g,d[i],' ');
close(g);
end.