Cod sursa(job #1095792)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 31 ianuarie 2014 21:31:43
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.13 kb
program bfs;
type lista=^celula;
        celula=record
             info:longint;
             urm:lista;
             end;
var a:array[1..100000] of lista;
    viz:array[1..100000] of 0..1;
    c,cost:array[1..100000] of integer;
    i,j,n,m,k,aux,x,y,p,u,s:integer;
    r:lista;

begin
assign(input,'bfs.in'); reset(input);
assign(output,'bfs.out'); rewrite(output);
readln(n,m,s);
for i:=1 to m do begin
                 readln(x,y);
                 new(r);
                 r^.info:=y;
                 r^.urm:=a[x];
                 a[x]:=r;
                 end;
for i:=1 to n do  cost[i]:=-1;
cost[s]:=0;
c[1]:=s;
p:=1; u:=1;
while (p<=u) do begin
             r:=a[c[p]];
             while r<>nil do begin
               if (cost[r^.info]=-1) then begin
                                          inc(u);
                                          c[u]:=r^.info;
                                          cost[c[u]]:=cost[c[p]]+1;
                                          end;
               r:=r^.urm;  end;
               inc(p);
               end;
for i:=1 to n do write(cost[i],' ');
close(output);
end.