Cod sursa(job #300630)

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

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 AddInCoada(var C : Coada; x : longint);
begin
  C.u:=C.u+1;
  C.a[C.u]:=x;
end;

function ExtractCoada(var C : Coada) : longint;
begin
  C.p:=C.p+1;
  ExtractCoada:=C.a[C.p-1];
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 : longint;
begin
  C.P:=1;
  C.U:=1;
  C.a[1]:=s;
  q[s]:=0;
  while C.p<=C.u do begin
    x:=ExtractCoada(C);
    g:=q[x]+1;
    while V[x]<>nil do begin
      y:=ExtractSt(V[x]);
      if q[y]=-1 then begin
        q[y]:=g;
        AddInCoada(C,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.