Cod sursa(job #257240)

Utilizator vladnVlad Nistorica vladn Data 12 februarie 2009 22:41:24
Problema BFS - Parcurgere in latime Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.03 kb
type point=^nod;
     nod=record
     inf:integer;
     leg:point;
     end;
var sel:array[1..100000] of boolean;
    d,coada:array [1..100000] of longint;
    a:array[1..100000] of point;
    p:point;
    f,g:text;
    n,m,s,i,x,y:longint;
procedure eu;
var st,dr:integer;
begin
  st:=1;dr:=1;
  sel[s]:=true;
  coada[1]:=s;
  d[s]:=0;
  while st<=dr do
  begin
       p:=a[coada[st]];
       while p<>nil do
       begin
         if sel[p^.inf]=false then
         begin
              inc(dr);
              coada[dr]:=p^.inf;
              sel[p^.inf]:=true;
              d[p^.inf]:=d[coada[st]]+1;
         end;
         p:=p^.leg;
       end;
       inc(st);
  end;
end;
begin
assign(f,'bfs.in');reset(f);
assign(g,'bfs.out');rewrite(g);
read(f,n,m,s);
for i:=1 to n do a[i]:=nil;
for i:=1 to m do
begin
     read(f,x,y);
     new(p);p^.inf:=y;p^.leg:=a[x];
     a[x]:=p;
end;
for i:=1 to n do d[i]:=-1;
fillchar(sel,n,false);
eu;
for i:=1 to n do
    write(g,d[i],' ');
writeln(g);
close(g);
end.