Cod sursa(job #1339439)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 10 februarie 2015 21:40:34
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
program mire;
var  f,g:text;
 a:array[1..5000,1..5000] of 0..1;
   co,pred:array[1..10000] of longint;
   viz:array[1..10000] of integer;
   n,m,i,j,ii,s,x,y,c:longint;
procedure bf;
var st,sf,p:longint;
begin
//for j:=1 to n do
//begin
   st:=1;
   sf:=1;
   co[st]:=s;
   viz[s]:=1;
  while st<=sf do
    begin
       for i:=1 to n do
        if (viz[i]=0) and (a[co[st],i]=1) then
         begin
           inc(sf);
           co[sf]:=i;
           viz[co[sf]]:=viz[co[st]]+1;
         end;
         //write(g,viz[i]-1,' ');
       st:=st+1;
    end;
     for i:=1 to n do
     write(g,viz[i]-1,' ');
   //end;
  end;
begin
  assign(f,'bfs.in'); reset(f);
  assign(g,'bfs.out'); rewrite(g);
    readln(f,n,m,s);
     for i:=1 to m do
       begin
        readln(f,x,y);
        a[x,y]:=1;
       end;
       bf;
  close(f);
  close(g);
end.