Cod sursa(job #1917683)

Utilizator mihaitamoglanmihai moglan mihaitamoglan Data 9 martie 2017 12:47:12
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 kb
type lista=^celula;
     celula=record
            info:longint;
            next:lista;
            end;
     tlista=array [1..100005]of lista;
     tablou=array [1..100010]of longint;
var a:tlista;
    coada, cost:tablou;
    i,j,k,m,q,n,x,y:longint;
    p:lista;
    f,g:text;


procedure nod(x,y:longint);
var r:lista;
begin
 new(r);
 r^.info:=y;
 r^.next:=a[x];
 a[x]:=r;
end;


procedure bfs(q:longint);
var r:lista;
    p,k:longint;
begin
 p:=1;
 k:=1;
 cost[q]:=0;
 coada[k]:=q;
 while k<=p do
  begin
   r:=a[coada[k]];
   while r<>nil do
    begin
      if cost[r^.info]=-1 then begin
                              cost[r^.info]:=cost[coada[k]]+1;
                              p:=p+1;
                              coada[p]:=r^.info;
                              end;
      r:=r^.next;
    end;
  k:=k+1;
  end;
 end;


begin
assign(f,'bfs.in');
assign(g,'bfs.out');
reset(f);
rewrite(g);
read(f,n,m,q);
for i:=1 to n do
 a[i]:=nil;
for i:=1 to m do
  begin
    read(f,x,y);
    nod(x,y);
   end;
for i:=1 to n do
 cost[i]:=-1;
bfs(q);
for i:=1 to n do
 write(g,cost[i],' ');
close(f);
close(g);
end.