Cod sursa(job #300637)

Utilizator mlazariLazari Mihai mlazari Data 7 aprilie 2009 16:13:41
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.44 kb
Program Bfs;
{ Breadth-first search * Parcurgere in latime }
type PNod=^Nod;
     Nod=record
       x : longint;
       next : PNod;
     end;
     Stiva=PNod;
var n,m,s : longint;
    q,ca : array[1..100001] of longint;
    V : array[1..100000] of Stiva;

procedure AddInSt(var S : Stiva; x : longint);
var W : Stiva;
begin
  new(W);
  W^.x:=x;
  W^.next:=S;
  S:=W;
end;

function ExtractSt(var S : Stiva) : longint;
var W : Stiva;
    rez : longint;
begin
  rez:=S^.x;
  W:=S;
  S:=S^.next;
  dispose(W);
  ExtractSt:=rez;
end;

procedure Citeste;
var Intrare : text;
    i,x,y : longint;
begin
  assign(Intrare,'bfs.in');
  reset(Intrare);
  readln(Intrare,n,m,s);
  for i:=1 to n do begin
    q[i]:=-1;
    V[i]:=nil;
  end;
  for i:=1 to m do begin
    readln(Intrare,x,y);
    AddInSt(V[x],y);
  end;
  close(Intrare);
end;

procedure Calculeaza;
var g,x,y,cp,cu : longint;
begin
  cp:=1;
  cu:=1;
  ca[1]:=s;
  q[s]:=0;
  while cp<=cu do begin
    x:=ca[cp];
    cp:=cp+1;
    g:=q[x]+1;
    while V[x]<>nil do begin
      y:=ExtractSt(V[x]);
      if q[y]=-1 then begin
        q[y]:=g;
        cu:=cu+1;
        ca[cu]:=y;
      end;
    end;
  end;
end;

procedure Scrie;
var Iesire : text;
    i : longint;
begin
  assign(Iesire,'bfs.out');
  rewrite(Iesire);
  for i:=1 to n do write(Iesire,q[i],' ');
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.