Cod sursa(job #253616)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 6 februarie 2009 00:28:03
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.24 kb
type point=^nod;
     nod=record
     inf:longint;
     leg:point;
     end;
var t,c,niv:array[1..100000] of integer;
    n,m,s,i:longint;
    a:array[1..100000] of point;
    f,g:text;
procedure load;
var p:point;
    i,x,y:longint;
begin
     assign(f,'bfs.in'); reset(f);
     assign(g,'bfs.out'); rewrite(g);
     readln(f,n,m,s);
     t[s]:=0; fillchar(niv,sizeof(niv),0);
     for i:=1 to n do a[i]:=nil;
     for i:=1 to m do
     begin
          readln(f,x,y);
          if x<>y then begin
          new(p);
          p^.inf:=y;
          p^.leg:=a[x];
          a[x]:=p;          end;
     end;
end;
procedure bf(x:longint);
var p,u:longint;
begin
     u:=1; p:=1;
     c[1]:=s;
     while p<=u do
     begin
          while a[c[p]]<>nil do
          begin
               inc(u);
               c[u]:=a[c[p]]^.inf;
               if a[c[u]]<>nil then begin
               t[c[u]]:=c[p];
               niv[c[u]]:=niv[c[p]]+1;   end;
               a[c[p]]:=a[c[p]]^.leg;
          end;
          inc(p);
     end;
end;
begin
     load;
     bf(s);
     for i:=1 to n do
          if niv[i]=0 then niv[i]:=-1;
     niv[s]:=0;
     for i:=1 to n do write(g,niv[i],' ');
     writeln(g);
     close(g);
end.