Cod sursa(job #1360240)

Utilizator maierraulMaier Raul maierraul Data 25 februarie 2015 13:11:25
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
program bfs;
type pcelula=^celula;
     celula=record
        x:longint;
        adr:pcelula;
        end;

var graf:array[1..100000] of pcelula;
    q,dist:array[1..100000] of longint;
    viz:array[1..100000] of boolean;
    f,g:text;
    n,m,s,i,x,y,iq,sq:lontint;
    p:pcelula;


procedure add(x,y:longint);
var aux:pcelula;
begin
new(aux);
aux^.x:=y;
aux^.adr:=graf[x];
graf[x]:=aux;
end;


begin
assign(f,'bfs.in'); reset(f);
assign(g,'bfs.out'); rewrite(g);
readln(f,n,m,s);
for i:=1 to n do begin
         graf[i]:=nil;
         dist[i]:=-1;
         viz[i]:=false;
         end;
for i:=1 to m do
        begin
        readln(f,x,y);
        add(x,y);
        end;
iq:=1; sq:=1;
viz[s]:=true;
q[iq]:=s;
dist[s]:=0;
while (iq<=sq) do begin
        nod:=q[iq];
        iq:=iq+1;
        p:=graf[nod]
        while p<>nil do
                begin
                if viz[p^.x]=false then
                        begin
                        sq:=sq+1;
                        q[sq]:=p^.x;
                        viz[p^.x]:=true;
                        dist[p^.x]:=dist[nod]+1;
                        end;
                p:=p^.adr;
                end;
for i:=1 to n do
        write(g,dist[i],' ');
close(f);
close(g);
end.