Cod sursa(job #269910)
Utilizator | Data | 3 martie 2009 16:15:22 | |
---|---|---|---|
Problema | BFS - Parcurgere in latime | Scor | 100 |
Compilator | fpc | Status | done |
Runda | Arhiva educationala | Marime | 1.62 kb |
type lista=^elem;
elem=record
v:longint;
ad:lista;
end;
var l:array [1..100000] of lista;
f,g:text;
i,m,n,x,y,uc,pc,s,w:longint;
c,viz: array [1..100000] of longint;
q,p:lista;
begin
assign(f,'bfs.in');
reset(f);
assign(g,'bfs.out');
rewrite(g);
read(f,n,m,s);
for i:=1 to m do begin
read(f,x,y);
new(q);
q^.v:=y;
if l[x]=nil then begin
l[x]:=q;
q^.ad:=nil;
end
else begin
q^.ad:=l[x];
l[x]:=q;
end;
end;
uc:=1;
pc:=1;
c[pc]:=s;
while pc<=uc do begin
x:=c[pc];
p:=l[x];
w:=viz[x];
while p<>nil do begin
if viz[p^.v]=0 then begin
uc:=uc+1;
c[uc]:=p^.v;
viz[p^.v]:=w+1;
end;
p:=p^.ad;
end;
pc:=pc+1;
end;
for i:=1 to n do if (viz[i]=0) and (s<>i) then write(g,'-1 ')
else if s=i then write(g,'0 ')
else write(g,viz[i],' ');
close(f);
close(g);
end.