Cod sursa(job #846498)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 2 ianuarie 2013 12:42:51
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.31 kb
program bfs;
  type lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;
  var f1,f2:text;
      n,m,s,x,y,i:longint;
      a:array [1..100000] of lista;
      r,coada,v,r2:lista;
      t:array [1..100000] of longint;
      bufin,bufout:array [1..100000] of byte;
begin
  assign(f1,'bfs.in');
  reset(f1);
  assign(f2,'bfs.out');
  rewrite(f2);
  settextbuf(f1,bufin);
  settextbuf(f2,bufout);
  readln(f1,n,m,s);
  for i:=1 to n do
    begin
      new(a[i]);
      a[i]^.next:=nil;
    end;
  for i:= 1 to m do
    begin
      readln(f1,x,y);
      new(r);
      r^.info:=y;
      r^.next:=a[x]^.next;
      a[x]^.next:=r;
    end;
  close(f1);
  for i:=1 to n do t[i]:=-1;
  t[s]:=0;
  new(coada);
  coada^.info:=s;
  coada^.next:=nil;
  v:=coada;
  while coada<>nil do
    begin
      r:=a[coada^.info]^.next;
      while r<>nil do
        begin
          if t[r^.info]=-1 then
            begin
              t[r^.info]:=t[coada^.info]+1;
              new(r2);
              r2^.info:=r^.info;
              r2^.next:=nil;
              v^.next:=r2;
              v:=r2;
            end;
          r:=r^.next;
        end;
      coada:=coada^.next;
    end;
  for i:=1 to n do write(f2,t[i],' ');
  close(f2);
end.