Cod sursa(job #581144)

Utilizator muskMuscalu Alexandru musk Data 13 aprilie 2011 20:08:08
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 kb
var a:array[0..5000,0..5000] of integer;
    i,j,k,n,m,st,dr,s:integer;
    c,use,t:array[1..5000] of integer;
    f,g:text;
procedure citire;
begin
assign(f,'bfs.in');
reset(f);
for i:=1 to n do
 for j:=1 to n do a[i,j]:=0;
read(f,n,m,s);
for k:=1 to m do
    begin
    read(f,i,j);
    a[i,0]:=a[i,0]+1;
    a[i,a[i,0]]:=j;
    a[j,0]:=a[j,0]+1;
    a[j,a[j,0]]:=i;
    end;
for i:=1 to n do use[i]:=0;
close(f);
end;

procedure bf;
begin
st:=1;
dr:=1;
use[s]:=1;
c[1]:=s;
t[s]:=0;
while st<=dr do
  begin
  k:=c[st];
  for j:=1 to a[k,0] do
      if (use[a[k,j]]=0)and(k<>a[k,j]) then
                     begin
                     dr:=dr+1;
                     c[dr]:=a[k,j];
                     use[a[k,j]]:=1;
                     t[j]:=t[k]+1;
                     end;
  st:=st+1;
  end;
end;



begin
citire;
k:=0;
bf;
assign(g,'bfs.out');rewrite(g);
for i:=1 to n do
       if (t[i]=0) and (i<>s) then write(g,'-1 ')
                            else write(g,t[i],' '); writeln;
close(g);


end.