Cod sursa(job #408617)

Utilizator saodem74hieu tran saodem74 Data 3 martie 2010 09:43:44
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
const tfi='bfs.in';
      tfo='bfs.out';
      maxn=100100;
      maxm=1000100;
type  li=record u,v:longint;
        end;
var   fi,fo:text;
    last,first,m,n,s:longint;
      st,ke:array[0..maxm] of longint;
      ds:array[0..maxm] of li;
      f,q:array[0..maxn] of longint;

procedure enter;
var i,j:longint;
begin
  read(fi,n,m,s);
  for i:=1 to m do
   with ds[i] do
    begin
     read(fi,u,v);
     inc(st[u]);
    end;
    inc(st[1]);
    for i:=2 to n+1 do st[i]:=st[i]+st[i-1];
    for i:=1 to m do
     with ds[i] do
      begin
        dec(st[u]);
        ke[st[u]]:=v;
      end;
end;

procedure push(u:longint);
begin
 inc(last);
 q[last]:=u;
end;

function pop:longint;
begin
 inc(first);
 pop:=  q[first];
end;
procedure process;
var i,j:longint;
begin
  push(s);
  repeat
    i:=pop;
    for j:=st[i] to st[i+1]-1 do
    if ke[j]<>i then
     if f[ke[j]]=0 then
     begin
      f[ke[j]]:=f[i]+1;
      push(ke[j]);
     end;
  until last=first;
  for i:=1 to n do
   if i=s then write(fo,0,' ')
    else
    if f[i]=0 then write(fo,'-1 ')
    else write(fo,f[i],' ');
end;

begin
  assign(fi,tfi); reset(fi);
  assign(fo,tfo); rewrite(fo);
  enter;
  process;
  close(fi); close(fo);
end.