Cod sursa(job #1339234)

Utilizator vergilius_beberindeie virgil vergilius_be Data 10 februarie 2015 19:30:46
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
program numarare;
var f,g:text;
    a:array[1..10000,1..10000] of 0..1;
    viz:array[1..10000] of 0..1;
    d,c:array[1..10000] of integer;
    i,j,n,m,s,x,y:longint;
             {
procedure df(nod:integer);
var i:integer;
begin
  viz[nod]:=1;
  for i:=1 to n do
    if (a[nod,i]=1) then
     begin
      if (viz[i]=0) then
         begin
           d[i]:=d[nod]+1;
           df(i);
         end
           else
             if viz[i]<>0 then
               if (d[i]>d[nod]+1) and (d[i]<>0) then
                 d[i]:=d[nod]+1;
    end;

end;
    }
procedure bf(nod:integer);
var i,st,dr:integer;
begin
 viz[nod]:=1;
 st:=0;
 dr:=1;
 c[1]:=nod;
 while st<dr do
   begin
      inc(st);
      for i:=1 to n do
        if a[c[st],i]=1 then
          begin
            if viz[i]=0 then
              begin
                d[i]:=d[c[st]]+1;
                inc(dr);
                c[dr]:=i;
                viz[i]:=1;
              end
                 else
                        if viz[i]<>0 then
                              if (d[i]>d[c[st]]+1) and (d[i]<>0) then
                                  d[i]:=d[c[st]]+1;
          end;
   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;
  d[s]:=0;
  bf(s);
  for i:=1 to n do
    if viz[i]=0 then
      write(g,-1,' ')
        else
         write(g,d[i],' ');

  close(f); close(g);
end.