Cod sursa(job #269868)

Utilizator rendorzegAndrei Pavel rendorzeg Data 3 martie 2009 15:15:27
Problema BFS - Parcurgere in latime Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.08 kb
var f,g:text;
    n,s,m,a,b,i,pc,uc,x,l:longint;
    d: array [1..100,1..100] of longint;
    c,v: array [1..1000] of longint;
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,a,b);
                 d[a,b]:=1;
                 end;
uc:=1;
pc:=1;
c[uc]:=s;
v[s]:=0;
while pc<=uc do begin
                x:=c[pc];
                l:=v[x];
                for i:=1 to n do if (d[x,i]=1) and (v[i]=0) then begin
                                                                  v[i]:=l+1;
                                                                  uc:=uc+1;
                                                                  c[uc]:=i;
                                                                  end;
                pc:=pc+1;
                end;
for i:=1 to n do if (v[i]=0) and (s<>i) then write(g,'-1 ')
                                        else if s=i then write(g,'0 ')
                                                    else write(g,v[i],' ');
close(f);
close(g);
end.