Cod sursa(job #408615)

Utilizator hungntnktpHungntnktp hungntnktp Data 3 martie 2010 09:42:41
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.43 kb
{DINH QUANG DAT TIN 07-10}
{BFS}
CONST
 TFI='bfs.in';
 TFO='bfs.out';
 MAX=100001;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 m,s,first,last,n:longint;
 queue,d:arr1int;
 ke:array[0..MAX] of pnode;
 free:array[0..MAX] of boolean;

PROCEDURE       add(u,v:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.next:=ke[u];
 ke[u]:=t;
end;

PROCEDURE       input;
var
 i,u,v:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,n,m,s);
  for i:= 1 to m do
   begin
    read(fi,u,v);
    add(u,v);
   end;
 close(fi);
end;

PROCEDURE       init;
begin
 fillchar(free,sizeof(free),true);
 first:=1;
 last:=0;
end;

PROCEDURE       push(u:longint);
begin
 inc(last);
 queue[last]:=u;
 free[u]:=false;
end;

FUNCTION        pop:longint;
begin
 pop:=queue[first];
 inc(first);
end;

PROCEDURE       process;
var
 u,v:longint;
 t:pnode;
begin
 push(s);
 repeat
  u:=pop;
  t:=ke[u];
  while t<>nil do
   begin
    v:=t^.v;
    t:=t^.next;
    if free[v] then
     begin
      d[v]:=d[u]+1;
      push(v);
     end;
   end;
 until first>last;
 for u:= 1 to n do
  if free[u] then d[u]:=-1;
end;

PROCEDURE       output;
var
 i:longint;
begin
 assign(fo,tfo);rewrite(fo);
  for i:= 1 to n do write(fo,d[i],' ');
 close(fo);
end;

BEGIN
 input;
 init;
 process;
 output;
END.