Cod sursa(job #1234445)

Utilizator radu_cebotariRadu Cebotari radu_cebotari Data 27 septembrie 2014 13:39:51
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.83 kb
Program a1;
type lista = ^nod;
     nod = record
       i:longint;
       urm:lista;
     end;
var v:array[1..100001] of lista;
    p,u:lista;
    sol:array[1..100001] of longint;
    viz:array[1..100001] of boolean;
    n,m,s:longint;
    f,g:text;

procedure adauga(x,y:longint);
var q:lista;
begin
   new(q);
   q^.i := y;
   q^.urm := v[x];
   v[x] := q;
end;

procedure adauga_in_coada(x:longint);
var q:lista;
begin
   new(q);
   q^.i := x;
   q^.urm := nil;
   if p = nil then begin
       p := q;
       u := q;
   end
   else begin
      u^.urm := q;
      u := q;
   end;
end;

procedure extrage_din_coada(var w:longint);
var q:lista;
begin
   w:=p^.i;
   q:=p;
   p := p^.urm;
   dispose(q);
end;

procedure citire;
var i,x,y:longint;
begin
    assign(f,'bfs.in');
    assign(g,'bfs.out');
    reset(f);
    rewrite(g);
    read(f,n,m,s);
    for i:=1 to m do begin
       read(f,x,y);
       adauga(x,y);
    end;
    close(f);
end;

function e_goala:boolean;
begin
   if p = nil then
      e_goala:=true
   else
      e_goala := false;
end;

procedure in_latime(start:longint);
var i,w:longint;
begin
    adauga_in_coada(start);
    sol[start] := 0;
    viz[start] := true;
    while (not e_goala) do begin
       extrage_din_coada(w);
       while v[w] <> nil do begin
           if not viz[v[w]^.i] then begin
              sol[v[w]^.i] := sol[w] + 1;
              adauga_in_coada(v[w]^.i);
           end;
           v[w] := v[w]^.urm;
       end;
    end;
end;

procedure afis;
var i:longint;
begin
   for i:= 1 to n do begin
      if sol[i] = 0 then begin
         if i = s then write(g,'0 ')
         else write(g,'-1 ');
      end
      else
          write(g,sol[i],' ');
   end;
close(g);
end;

begin
   citire;
   in_latime(s);
   afis;
end.