Cod sursa(job #253620)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 6 februarie 2009 00:37:20
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.45 kb
type point=^nod;
     nod=record
     inf:longint;
     leg:point;
     end;
var t,niv:array[1..100000] of integer;
    n,m,s,i:longint;
    c:array[1..1000000] of longint;
    a:array[1..100000] of point;
    sel:array[1..100000] of boolean;
    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;
     fillchar(sel,sizeof(sel),false);
     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;
     sel[s]:=true;
     c[1]:=s;
     while p<=u do
     begin
          while a[c[p]]<>nil do
          begin
               inc(u);
               c[u]:=a[c[p]]^.inf;
               if sel[c[u]]=false then
               begin
                    t[c[u]]:=c[p];
                    niv[c[u]]:=niv[c[p]]+1;
                    sel[c[u]]:=true;
               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.