Cod sursa(job #673332)

Utilizator mada0222Tomus Madalina mada0222 Data 4 februarie 2012 12:19:53
Problema BFS - Parcurgere in latime Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.07 kb
program ssss;
type mi=record
x,y:integer;
end;
var f,g:text;
    n,m,i,j,s,k1,k2,st,sf,x,y:longint;
    a:array[0..100000,0..100000] of integer;
    d,viz,v:array[0..100000]of integer;
    rec:array[1..1000000] of mi;
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,rec[i].x,rec[i].y);
          a[rec[i].x,rec[i].y]:=1;
        end;
    st:=0;
    sf:=1;
    viz[s]:=1;
    v[1]:=s;
    while st<sf do
      begin
      st:=st+1;
      for i:=1 to n do
        begin
          if (a[v[st],i]=1) and (viz[i]=0) then
            begin
            viz[i]:=1;
            sf:=sf+1;
            v[sf]:=i;
            d[i]:=d[v[st]]+1;
            end;
        end;
      end;
      for i:=1 to n do
      begin
      if (i<>s) and (d[i]=0) then
        d[i]:=-1;
        write(g,d[i],' ');
      end;
    { for i:=1 to n do
        if pred[sf]=0 then
          writeln(g,'DA')
          else
          writeln(g,'NU');   }
  close(f);
  close(g);
end.