Cod sursa(job #1338435)

Utilizator ioanacosteaIoana Costea ioanacostea Data 10 februarie 2015 00:36:37
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.75 kb
const max=20000;
var a:array[1..max,1..max]of byte;
    f:text;
    p,i,j,n,m,s:longint;
    viz,b,c:array[1..max]of longint;
    x,y:longint;
begin
 assign(f,'bfs.in');reset(f);
 readln(f,n,m,s);
 for i:=1 to n do
   for j:=1 to n do a[i,j]:=0;
 for i:=1 to m do
 begin
    read(f,x,y);
    a[x,y]:=1;
 end;
 for i:=1 to n do viz[i]:=-1;
 close(f);
if n<=max then begin
i:=1;
p:=1;
b[1]:=s;
c[1]:=0;
viz[s]:=0;
while i<=p do
  begin
    x:=b[i];
    for j:=1 to n do
      if (viz[j]=-1) and (a[x,j]=1) then
       begin
         inc(p);
         b[p]:=j;
         c[p]:=c[i]+1;
         viz[j]:=c[p];
       end;
     inc(i);
    end;
end;
assign(f,'bfs.out');
rewrite(f);
for i:=1 to n do write(f,viz[i],' ');
close(f);
end.