Cod sursa(job #1405547)

Utilizator ButnaruButnaru George Butnaru Data 29 martie 2015 13:04:16
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
program bfs;
const inf=999999;
type
buf=array[0..1 shl 17] of char;
lista=^date;
date=record
m:longint;
next:lista;
end;
tabel=array[0..100001] of lista;
tabb=array[0..100001] of longint;
var
t:tabel; coada,fr,d:tabb;
a:lista; ff1,ff2:buf;
x,y,n,i,j,k,pr,ul,m:longint;
f1,f2:text;
begin
assign (f1,'bfs.in');
assign (f2,'bfs.out');
reset (f1);
rewrite (f2);
settextbuf(f1,ff1);
settextbuf(f2,ff2);
readln (f1,n,m,k);
for i:=1 to m do begin
readln (f1,x,y);
new(a); a^.m:=y; a^.next:=t[x]; t[x]:=a;
end;
for i:=1 to n do d[i]:=inf;
pr:=0; ul:=1; coada[ul]:=k; fr[k]:=1; d[k]:=0;
repeat
pr:=pr+1; a:=t[coada[pr]];
while a<>nil do begin
if fr[a^.m]=0 then begin
fr[a^.m]:=1; d[a^.m]:=d[coada[pr]]+1;
ul:=ul+1; coada[ul]:=a^.m;
end;
a:=a^.next;
end;
until pr=ul;
for i:=1 to n do
if d[i]=inf then write (f2,-1,' ') else write (f2,d[i],' ');
close (f1);
close (f2);
end.