Cod sursa(job #379193)

Utilizator cristinabCristina Brinza cristinab Data 30 decembrie 2009 22:44:22
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
{parcurgere in latime}

type ref=^nod;
     nod=record
         vf:longint;
         leg:ref;
         end;
     domeniu=0..1;

var marc:array[1..100000] of longint;
    prim:array[1..100000] of ref;
    n,m,s:longint;

procedure adaug(x,y:longint);
var c:ref;
begin
new(c);
c^.vf:=y;
c^.leg:=prim[x];
prim[x]:=c;
end;

procedure citire;
var x,y,i:longint;
begin
assign(input,'bfs.in'); reset(input);
readln(n,m,s);
for i:=1 to m do
    begin
    readln(x,y);
    adaug(x,y);
    end;
close(input);
end;

procedure bf;
var p,u,i,v:longint;
    c:array[1..100000] of longint;
    lg:ref;
begin
for i:=1 to n do marc[i]:=-1;
p:=1;
u:=1;
c[p]:=s;
marc[s]:=0;

while p<=u do
      begin
      v:=c[p];
      lg:=prim[v];
      while lg<>nil do
            begin
            if marc[lg^.vf]=-1 then
               begin
               inc(u);
               c[u]:=lg^.vf;
               marc[lg^.vf]:=marc[v]+1;
               end;
            lg:=lg^.leg;
            end;
      inc(p);
      end;
end;



procedure afisare;
var i:longint;
begin

assign(output,'bfs.out'); rewrite(output);
for i:=1 to n do write(marc[i],' ');
close(output);
end;

begin
citire;
bf;
afisare;
end.