Cod sursa(job #493918)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 19 octombrie 2010 21:26:43
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.28 kb
program bfs;
const maxn=100001;
      maxm=1000001;
type inod=0..maxn;
     iarc=0..maxm;
     pnod=^nod;
     nod= record
     inf:inod;
     next:pnod;
     end;
var f,g:text; A,ult:array[inod] of pnod; n,s:inod;
D:array[inod] of 0..maxm; m:iarc; i:longint;
procedure citire;
var x,y:inod; q:pnod;
begin
Readln(f,n,m,s);
For i:=1 to m do
 begin
 Readln(f,x,y);
 If x<>y then
  begin
  new(q);
  q^.inf:=y;
  If A[x]=nil then begin A[x]:=q; ult[x]:=A[x]; end
              else begin ult[x]^.next:=q; ult[x]:=q; end;
  end;
 end;
end;
procedure bfs;
var c:array[1..maxn] of 1..maxn; ps,pi:inod; x:pnod;
begin
ps:=1; pi:=1; c[ps]:=s; {s=primul nod}
While ps<=pi do
 begin
 x:=A[c[ps]];            {x= pointer spre nodul curent}
 While x<>nil do
  begin
  If (D[x^.inf]=0)and(x^.inf<>s) then {daca nodul nu a mai fost vizitat}
   begin
   D[x^.inf]:=D[c[ps]]+1;
   inc(pi);         {adauga nodul vecin gasit in coada}
   c[pi]:=x^.inf;
   end;
  x:=x^.next; {se trece la vecinul urmator}
  end;
 inc(ps); {se trece la nodul urmator din coada}
 end;

end;

begin
Assign(f,'bfs.in'); Reset(f);
Assign(g,'bfs.out');Rewrite(g);
citire; Close(f);
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.