Cod sursa(job #1900497)

Utilizator mihaitamoglanmihai moglan mihaitamoglan Data 3 martie 2017 13:44:26
Problema BFS - Parcurgere in latime Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.24 kb
type lista=^celula;
     celula=record
             info:longint;
             next:lista;
             end;
     tablou=array [1..100100]of lista;
     tab=array [1..100100]of longint;
     boo=array [1..100100]of 0..1;
var a:tablou;
    rez,t:tab;
    viz:boo;
    i,j,k,m,n,x,p,q:longint;
    f,g:text;


procedure adauga(var aux:lista;x:longint);
var r:lista;
begin
new(r);
r^.info:=x;
r^.next:=aux;
aux:=r;
end;


procedure bfs(var x,i,k:longint);
var r:lista;
 begin
   r:=a[x];
   viz[x]:=1;
   while r<>nil do
    begin
       if viz[r^.info]=0 then begin
                                rez[r^.info]:=rez[x]+1;
                                k:=k+1;
                                t[k]:=r^.info;
                                end;
       r:=r^.next;
    end;
    i:=i+1;
   if i<=k then bfs(t[i],i,k);
 end;



begin
assign(f,'bfs.in') ;
assign(g,'bfs.out');
reset(f);
rewrite(g);
read(f,n,m,x);
for i:=1 to n do
 begin
  a[i]:=nil;
  viz[i]:=0;
  rez[i]:=0;
 end;
viz[x]:=1;
for i:=1 to m do
 begin
  read(f,p,q);
  adauga(a[p],q);
 end;
t[1]:=x;
k:=1;
i:=1;
bfs(x,i,k);
for i:=1 to n do
 if viz[i]=0 then rez[i]:=-1;
for i:=1 to n do
 write(g,rez[i],' ') ;
close(f);
close(g);
end.