Cod sursa(job #846544)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 2 ianuarie 2013 13:42:39
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.72 kb
program bfs;
  var f1,f2:text;
      a:array [1..2,1..1000000] of longint;
      b:array [1..100000] of longint;
      n,m,s,i:longint;
      bool:boolean;
begin
  assign(f1,'bfs.in');
  reset(f1);
  assign(f2,'bfs.out');
  rewrite(f2);
  readln(f1,n,m,s);
  for i:=1 to m do readln(f1,a[1,i],a[2,i]);
  for i:=1 to n do b[i]:=-1;
  b[s]:=0; bool:=true;
  while bool do
    begin
      bool:=false;
      for i:=1 to m do
        begin
          if (b[a[1,i]]<>-1) and ((b[a[2,i]]=-1)or(b[a[2,i]]>b[a[1,i]]+1)) then
            begin
              b[a[2,i]]:=b[a[1,i]]+1;
              bool:=true;
            end;
        end;
    end;
  for i:=1 to n do write(f2,b[i],' ');
  close(f1);
  close(f2);
end.