Cod sursa(job #269910)

Utilizator rendorzegAndrei Pavel rendorzeg 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.