Cod sursa(job #1101494)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 8 februarie 2014 16:11:03
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
program bfs;
type lista=^celula;
     celula=record
       info:longint;
       urm:lista;
       end;
var a:array[1..120000] of lista;
    coada,cost,viz:array[1..120000] of longint;
    n,m,i,s,prim,ultim,x,y:longint;
    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;
 viz[s]:=1;
 prim:=1; ultim:=1;
 coada[1]:=s;
 while (prim<=ultim) do begin
             r:=a[coada[prim]];
             while r<>nil do begin
                     if viz[r^.info]=0 then
                                        begin
                                        inc(ultim);
                                        coada[ultim]:=r^.info;
                                        viz[r^.info]:=1;
                                        cost[r^.info]:=cost[coada[prim]]+1;
                                        end;
                         r:=r^.urm;
                         end;
             inc(prim);
             end;
 for i:=1 to n do write(cost[i],' ');
 close(output);
end.