Cod sursa(job #1338423)

Utilizator ioanacosteaIoana Costea ioanacostea Data 9 februarie 2015 23:56:46
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.73 kb
const max=5000;
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);
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;
assign(f,'bfs.out');
rewrite(f);
for i:=1 to n do write(f,viz[i],' ');
close(f);
end.