Cod sursa(job #1420380)

Utilizator ButnaruButnaru George Butnaru Data 18 aprilie 2015 13:19:15
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
program bfs;
const inf=trunc(1 shl 23);
type
lista=^date;
date=record
m:longint;
next:lista;
end;
   vector1=array[0..100001] of lista;
   vector2=array[0..100001] of longint;
   buf=array[0..1 shl 17] of char;
var t:vector1; fr,d,coada:vector2;
    n,m,s,i,j,x,y,pr,ul:longint; a:lista;
    f1,f2:text;
begin
assign (f1,'bfs.in');
assign (f2,'bfs.out');
reset (f1);
rewrite (f2);
readln (f1,n,m,s);
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;
d[s]:=0; pr:=0; ul:=1; coada[ul]:=s; fr[s]:=1;
repeat
pr:=pr+1; x:=coada[pr]; a:=t[x];
while a<>nil do begin
if fr[a^.m]=0 then begin
fr[a^.m]:=1; d[a^.m]:=d[x]+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.