Cod sursa(job #555450)

Utilizator lakat_tLakatos Tamas lakat_t Data 15 martie 2011 15:14:38
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.19 kb
type
 lista=^elem;
 elem=record
  vp:longint;
  kov:lista;
 end;

var
 f:text;
 i,n,m,s,a,b,k,l:longint;
 multi:array[1..100000] of record
  sz:lista;
  volt:boolean;
 end;
 tav:array[1..100000] of longint;
 v:array[1..100000] of record
  lep:longint;
  id:longint;
 end;

procedure beszur(var hova:lista; mit:longint);
var
 p:lista;
begin
 new(p);
 p^.vp:=mit;
 p^.kov:=hova;
 hova:=p;
end;

procedure kiterjeszt(pont:longint);
var
 p:lista;
begin
 p:=multi[pont].sz;
 while p<>nil do
  begin
   if multi[p^.vp].volt=false
    then begin
          inc(k);
          v[k].lep:=v[l].lep+1;
          v[k].id:=p^.vp;
          multi[p^.vp].volt:=true;
         end;
   p:=p^.kov;
  end;
end;

begin
 assign(f, 'bfs.in');
 reset(f);
 readln(f, n, m, s);
 for i:=1 to m do
  begin
   readln(f, a,b);
   beszur(multi[a].sz,b);
  end;
 close(f);
 v[1].lep:=0;
 v[1].id:=s;
 multi[s].volt:=true;
 l:=1;
 k:=1;
 while l<=k do
  begin
   kiterjeszt(v[l].id);
   inc(l);
  end;
 for i:=1 to n do
  tav[i]:=-1;
 for i:=1 to k do
  tav[v[i].id]:=v[i].lep;
 assign(f, 'bfs.out');
 rewrite(f);
 for i:=1 to n do
  write(f, tav[i],' ');
 close(f);
end.