Cod sursa(job #410771)

Utilizator skullLepadat Mihai-Alexandru skull Data 4 martie 2010 16:21:48
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
type pnod=^nod;
     nod=record
     inf:longint;
     urm:pnod;
     end;
var v:array [1..100000] of pnod;
    c,val:array [1..100000] of longint;
    buf,bug:array [1..32000] of byte;
    n,m,st,dr,s,i,x,y:longint;
    q:pnod;
    f,g:text;

procedure addlist(x,y:longint);
var q:pnod;
          begin
          if v[x]=nil then
             begin
             new(q);
             q^.inf:=y;
             q^.urm:=nil;
             v[x]:=q;
             end
             else
             begin
             new(q);
             q^.inf:=y;
             q^.urm:=v[x];
             v[x]:=q;
             end;
          end;

begin
assign(f,'bfs.in');reset(f);
settextbuf(f,buf);
readln(f,n,m,s);
for i:=1 to m do
    begin
    readln(f,x,y);
    addlist(x,y);
    end;
close(f);
c[1]:=s;val[s]:=0;st:=1;dr:=1;
while st<=dr do
      begin
      q:=v[c[st]];
      while q<>nil do
            begin
            if (val[q^.inf]=0) and (q^.inf<>s) then
               begin
               dr:=dr+1;
               c[dr]:=q^.inf;
               val[c[dr]]:=val[c[st]]+1;
               end;
            q:=q^.urm;
            end;
      st:=st+1;
      end;
assign(g,'bfs.out');rewrite(g);
settextbuf(g,bug);
for i:=1 to n do
    if i<>s then
       if val[i]<>0 then
          write(g,val[i],' ')
          else
          write(g,'-1 ')
       else
       write(g,'0 ');
close(g);
end.