Cod sursa(job #1352152)

Utilizator mariusadamMarius Adam mariusadam Data 21 februarie 2015 12:05:47
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 kb
program distanta_min_bf;
type lista=array[0..1,1..2000000] of longint;
     pornire=array[1..100000] of longint;
     vizitat=array[1..100000] of 0..1;
     coada=array[1..100000] of longint;
     distanta=array[1..100000] of longint;
     buff=array[1..1000000] of byte;
var l:lista; p:pornire; viz:vizitat; cd:coada; d:distanta;
    bufin,bufout:buff;
    n,m,s,i:longint;
    f,g:text;

procedure citire;
var i,j,k,z:longint;
begin
 assign(f,'bfs.in'); reset(f);
 SetTextBuf(f,bufin);
 SetTextBuf(g,bufout);
 readln(f,n,m,s);
 k:=0;
 for z:=1 to m do
  begin
   readln(f,i,j); k:=k+1;
   l[0,k]:=j; l[1,k]:=p[i]; p[i]:=k;
  end;
 close(f);
end;

procedure bf(nod:longint);
var z,st,sf:integer;
begin
 viz[nod]:=1; st:=1; sf:=1; cd[st]:=nod;
 while st<=sf do
  begin
   z:=p[cd[st]];
   while z<>0 do
    begin
     if viz[l[0,z]]=0 then
      begin
       sf:=sf+1;
       cd[sf]:=l[0,z];
       viz[l[0,z]]:=1;
       d[cd[sf]]:=d[cd[st]]+1;
      end;
     z:=l[1,z];
    end;
  st:=st+1;
 end;
end;

begin
 assign(g,'bfs.out'); rewrite(g);
 citire;
 bf(s);
 for i:=1 to n do
  if viz[i]=1 then
   write(g,d[i],' ')
  else
   write(g,-1,' ');
 close(g);
end.