Cod sursa(job #243976)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 14 ianuarie 2009 12:29:12
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.09 kb
type lista=^element;
     element=record
         i:longint;
         a:lista;
             end;
var ultim,c,p:lista;
    l:array[1..100001] of longint;
    v:array[1..100001] of lista;
    i,d,n,m,s,a,b:longint;

procedure bfs(s,d:longint); inline;
    var w:lista;
    begin
      p:=v[s];
      while p<>nil do
        begin
          if l[p^.i]=-1 then
            begin
              l[p^.i]:=d;
              new(w); w^.i:=p^.i; w^.a:=nil; ultim^.a:=w;
              ultim:=w
            end;
          p:=p^.a;
        end;
      if c<>nil then
         begin
           c:=c^.a;
           bfs(c^.i,d+1);
         end;
    end;

begin
assign(input,'bfs.in'); reset(input);
readln(n,m,s);
for i:=1 to n do
  begin
    v[i]:=nil;
    l[i]:=-1;
  end;
l[s]:=0;
for i:=1 to m do
  begin
    readln(a,b);
    new(p);
    p^.i:=b;
    p^.a:=v[a];
    v[a]:=p;
  end;
close(input);

new(p); p^.i:=s; p^.a:=nil; c:=p; ultim:=p;
d:=1;
bfs(s,d);

assign(output,'bfs.out'); rewrite(output);
for i:=1 to n-1 do write(l[i],' ');
writeln(l[n],' ');
close(output);
end.