Cod sursa(job #300646)

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

procedure Citeste;
var Intrare : text;
    i,x,y : longint;
    W : Stiva;
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);
    new(W);
    W^.x:=y;
    W^.next:=V[x];
    V[x]:=W;
  end;
  close(Intrare);
end;

procedure Calculeaza;
var g,x,y,cp,cu : longint;
    W : Stiva;
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:=V[x]^.x;
      W:=V[x];
      V[x]:=V[x]^.next;
      dispose(W);
      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.