Cod sursa(job #271326)

Utilizator philipPhilip philip Data 5 martie 2009 09:49:09
Problema BFS - Parcurgere in latime Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 0.92 kb
var f,g:text;
    n,m,i,j,xp,u,p:longint;
    a:array[1..100000,1..100000] of boolean;
    viz:array[0..100001] of boolean;
    c,x:array[1..100001] of longint;

procedure citire;
  var x,y:longint;
  begin
    assign(f,'bfs.in');
    reset(f);
    readln(f,n,m,xp);
    for i:=1 to m do begin
      readln(f,x,y);
      a[x,y]:=true;
    end;
    assign(g,'bfs.out');
    rewrite(g);
  end;

procedure bfs;
  begin
    c[1]:=xp;
    viz[xp]:=true;
    u:=1;
    p:=1;
    while p<=u do begin
      for i:=1 to n do
        if (a[c[p],i]=true) and (viz[i]=false) then begin
          inc(u);
          c[u]:=i;
          viz[i]:=true;
          x[c[u]]:=x[c[p]]+1;
        end;
        inc(p);
    end;
  end;

procedure afisare;
  begin
    for i:=1 to n do if (i<>xp) and (x[i]=0) then
     write(g,-1,' ') else write(g,x[i],' ');
    close(g);
  end;

begin
  citire;
  bfs;
  afisare;
end.