Cod sursa(job #1339229)

Utilizator vergilius_beberindeie virgil vergilius_be Data 10 februarie 2015 19:29:02
Problema BFS - Parcurgere in latime Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 0.92 kb
program numarare;
var a:array[1..10000,1..10000] of 0..1;
    viz:array[1..10000] of 0..1;
    d:array[1..10000] of longint;
    n,m,s,i,l,c,k:longint;
    f,g:text;

procedure df(s:longint);
var i:longint;
begin
 viz[s]:=1;
 for i:=1 to n do
  if (viz[i]=0) and (a[s,i]=1) then
   begin
    k:=k+1; d[i]:=k;
    df(i);
    k:=k-1;

   { if i<>s then
     write(k,i,' ')
    else
     write(0,' ');}
   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,l,c);
   a[l,c]:=1;
  end;
 {for l:=1 to n do
  begin
   for c:=1 to n do
    write(a[l,c]:2);
   writeln;
  end;}
     df(s); k:=0;

 for i:=1 to n do
  begin
   if viz[i]=0 then
    write(g,-1,' ')
   else
    write(g,d[i],' ');
  end;
 {writeln; writeln;
 for i:=1 to n do
  if viz[i]=1 then
   write(i,' '); }
 close(f);
 close(g);
end.