Cod sursa(job #1900409)

Utilizator mihaitamoglanmihai moglan mihaitamoglan Data 3 martie 2017 12:54:12
Problema BFS - Parcurgere in latime Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.1 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: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: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;
                        bfs(r^.info);
                        end;
       r:=r^.next;
    end;
 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;
bfs(x);
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.