Cod sursa(job #401275)

Utilizator nickyyLal Daniel Emanuel nickyy Data 22 februarie 2010 18:32:06
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.23 kb
const infile='bfs.in';
  outfile='bfs.out';
  maxn=100001;
  maxm=1000001;
type lista=^nod;
  nod=record
        inf:longint;
        next:lista;
        end;
var a:array[0..maxn]of lista;
  q,d:array[0..maxn]of longint;
  uz:array[0..maxn]of byte;
  n,m,s:longint;

  procedure citire;
  var f:text;
    i,j:longint;
    p:lista;
  begin
    assign(f,infile); reset(f); readln(f,n,m,s);
    while(m>0)do begin
      readln(f,i,j); dec(m);
      new(p); p^.inf:=j; p^.next:=a[i]; a[i]:=p;
      end;
    close(f);
  end;

  procedure bfs(x:longint);
  var ic,sf:longint;
    p:lista;
  begin
    fillchar(d,sizeof(d),0); fillchar(uz,sizeof(uz),0);
    ic:=1; sf:=1; q[sf]:=x; uz[x]:=1;
    while(ic<=sf)do begin
      p:=a[q[ic]];
      while(p<>nil)do begin
        if(uz[p^.inf]=0)then begin
          uz[p^.inf]:=1; inc(sf); q[sf]:=p^.inf; d[p^.inf]:=d[q[ic]]+1;
          end;
        p:=p^.next;
        end;
      inc(ic);
      end;
  end;

  procedure afisare;
  var i:longint;
    f:text;
  begin
    assign(f,outfile); rewrite(f);
    for i:=1 to n do
      if(d[i]=0)and(i<>s)then write(f,-1,' ')
      else write(f,d[i],' ');
    close(f);
  end;

begin
citire; bfs(s); afisare;
end.